index.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:4k
源码类别:

通讯编程

开发平台:

Visual C++

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