index.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:4k
- # 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} {}