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