1# index.tcl --
2#
3# This file defines procedures that are used during the first pass of
4# the man page conversion.  It is used to extract information used to
5# generate a table of contents and a keyword list.
6#
7# Copyright (c) 1996 by Sun Microsystems, Inc.
8#
9# See the file "license.terms" for information on usage and redistribution
10# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11#
12# RCS: @(#) $Id: index.tcl,v 1.3.40.1 2003/06/04 23:41:15 mistachkin Exp $
13#
14
15# Global variables used by these scripts:
16#
17# state -	state variable that controls action of text proc.
18#
19# topics -	array indexed by (package,section,topic) with value
20# 		of topic ID.
21#
22# keywords -	array indexed by keyword string with value of topic ID.
23#
24# curID - 	current topic ID, starts at 0 and is incremented for
25# 		each new topic file.
26#
27# curPkg -	current package name (e.g. Tcl).
28#
29# curSect -	current section title (e.g. "Tcl Built-In Commands").
30#
31
32# getPackages --
33#
34# Generate a sorted list of package names from the topics array.
35#
36# Arguments:
37# none.
38
39proc getPackages {} {
40    global topics
41    foreach i [array names topics] {
42	regsub {^(.*),.*,.*$} $i {\1} i
43	set temp($i) {}
44    }
45    lsort [array names temp]
46}
47
48# getSections --
49#
50# Generate a sorted list of section titles in the specified package
51# from the topics array.
52#
53# Arguments:
54# pkg -			Name of package to search.
55
56proc getSections {pkg} {
57    global topics
58    regsub -all {[][*?\\]} $pkg {\\&} pkg
59    foreach i [array names topics "${pkg},*"] {
60	regsub {^.*,(.*),.*$} $i {\1} i
61	set temp($i) {}
62    }
63    lsort [array names temp]
64}
65
66# getTopics --
67#
68# Generate a sorted list of topics in the specified section of the
69# specified package from the topics array.
70#
71# Arguments:
72# pkg -			Name of package to search.
73# sect -		Name of section to search.
74
75proc getTopics {pkg sect} {
76    global topics
77    regsub -all {[][*?\\]} $pkg {\\&} pkg
78    regsub -all {[][*?\\]} $sect {\\&} sect
79    foreach i [array names topics "${pkg},${sect},*"] {
80	regsub {^.*,.*,(.*)$} $i {\1} i
81	set temp($i) {}
82    }
83    lsort [array names temp]
84}
85
86# text --
87#
88# This procedure adds entries to the hypertext arrays topics and keywords.
89#
90# Arguments:
91# string -		Text to index.
92
93
94proc text string {
95    global state curID curPkg curSect topics keywords
96
97    switch $state {
98	NAME {
99	    foreach i [split $string ","] {
100		set topic [string trim $i]
101		set index "$curPkg,$curSect,$topic"
102		if {[info exists topics($index)]
103		    && [string compare $topics($index) $curID] != 0} {
104		    puts stderr "duplicate topic $topic in $curPkg"
105		}
106		set topics($index) $curID
107		lappend keywords($topic) $curID
108	    }
109	}
110	KEY {
111	    foreach i [split $string ","] {
112		lappend keywords([string trim $i]) $curID
113	    }
114	}
115	DT -
116	OFF -
117	DASH {}
118	default {
119	    puts stderr "text: unknown state: $state"
120	}
121    }
122}
123
124
125# macro --
126#
127# This procedure is invoked to process macro invocations that start
128# with "." (instead of ').
129#
130# Arguments:
131# name -	The name of the macro (without the ".").
132# args -	Any additional arguments to the macro.
133
134proc macro {name args} {
135    switch $name {
136	SH {
137	    global state
138
139	    switch $args {
140		NAME {
141		    if {$state == "INIT" } {
142			set state NAME
143		    }
144		}
145		DESCRIPTION {set state DT}
146		INTRODUCTION {set state DT}
147		KEYWORDS {set state KEY}
148		default {set state OFF}
149	    }
150
151	}
152	TH {
153	    global state curID curPkg curSect topics keywords
154	    set state INIT
155	    if {[llength $args] != 5} {
156		set args [join $args " "]
157		puts stderr "Bad .TH macro: .$name $args"
158	    }
159	    incr curID
160	    set topic	[lindex $args 0]	;# Tcl_UpVar
161	    set curPkg	[lindex $args 3]	;# Tcl
162	    set curSect	[lindex $args 4]	;# {Tcl Library Procedures}
163	    regsub -all {\\ } $curSect { } curSect
164	    set index "$curPkg,$curSect,$topic"
165	    set topics($index) $curID
166	    lappend keywords($topic) $curID
167	}
168    }
169}
170
171
172# dash --
173#
174# This procedure is invoked to handle dash characters ("\-" in
175# troff).  It only function in pass1 is to terminate the NAME state.
176#
177# Arguments:
178# None.
179
180proc dash {} {
181    global state
182    if {$state == "NAME"} {
183	set state DASH
184    }
185}
186
187
188
189# initGlobals, tab, font, char, macro2 --
190#
191# These procedures do nothing during the first pass.
192#
193# Arguments:
194# None.
195
196proc initGlobals {} {}
197proc newline {} {}
198proc tab {} {}
199proc font type {}
200proc char name {}
201proc macro2 {name args} {}
202
203