index.tcl

tcl是工具命令语言

# 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 1998/09/14 18:40:15 stanton 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]
}

# getSections --
#
# 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} {}