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