man2help2.tcl

tcl是工具命令语言

# man2help2.tcl --
#
# This file defines procedures that are used during the second pass of
# the man page conversion.  It converts the man format input to rtf
# form suitable for use by the Windows help compiler.
#
# 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: man2help2.tcl,v 1.12 2002/10/03 13:34:32 dkf 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").
#

# initGlobals --
#
# This procedure is invoked to set the initial values of all of the
# global variables, before processing a man page.
#
# Arguments:
# None.

proc initGlobals {} {
    uplevel \#0 unset state
    global state chars

    set state(paragraphPending) 0
    set state(breakPending) 0
    set state(firstIndent) 0
    set state(leftIndent) 0

    set state(inTP) 0
    set state(paragraph) 0
    set state(textState) 0
    set state(curFont) ""
    set state(startCode) "{\\b "
    set state(startEmphasis) "{\\i "
    set state(endCode) "}"
    set state(endEmphasis) "}"
    set state(noFill) 0
    set state(charCnt) 0
    set state(offset) [getTwips 0.5i]
    set state(leftMargin) [getTwips 0.5i]
    set state(nestingLevel) 0
    set state(intl) 0
    set state(sb) 0
    setTabs 0.5i

# set up international character table

    array set chars {
	o^ F4
    }
}


# beginFont --
#
# Arranges for future text to use a special font, rather than
# the default paragraph font.
#
# Arguments:
# font -		Name of new font to use.

proc beginFont {font} {
    global file state

    textSetup
    if {[string equal $state(curFont) $font]} {
	return
    }
    endFont
    puts -nonewline $file $state(start$font)
    set state(curFont) $font
}


# endFont --
#
# Reverts to the default font for the paragraph type.
#
# Arguments:
# None.

proc endFont {} {
    global state file

    if {[string compare $state(curFont) ""]} {
	puts -nonewline $file $state(end$state(curFont))
	set state(curFont) ""
    }
}


# textSetup --
#
# This procedure is called the first time that text is output for a
# paragraph.  It outputs the header information for the paragraph.
#
# Arguments:
# None.

proc textSetup {} {
    global file state

    if $state(breakPending) {
	puts $file "\\line"
    }
    if $state(paragraphPending) {
	puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \
			$state(firstIndent) $state(leftIndent)]
	foreach tab $state(tabs) {
	    puts $file [format "\\tx%.0f" $tab]
	}
	set state(tabs) {}
	if {$state(sb)} {
	    puts $file "\\sb$state(sb)"
	    set state(sb) 0
	}
    }
    set state(breakPending) 0
    set state(paragraphPending) 0
}


# text --
#
# This procedure adds text to the current state(paragraph).  If this is
# the first text in the state(paragraph) then header information for the
# state(paragraph) is output before the text.
#
# Arguments:
# string -		Text to output in the state(paragraph).

proc text {string} {
    global file state chars

    textSetup
    set string [string map [list \
	    "\\"	"\\\\" \
	    "\{"	"\\\{" \
	    "\}"	"\\\}" \
	    "\t"	{\tab } \
	    ''		"\\rdblquote " \
	    ``		"\\ldblquote " \
	    ] $string]

    # Check if this is the beginning of an international character string.
    # If so, look up the sequence in the chars table and substitute the
    # appropriate hex value.

    if {$state(intl)} {
	if {[regexp {^'([^']*)'} $string dummy ch]} {
	    if {[info exists chars($ch)]} {
		regsub {^'[^']*'} $string "\\\\'$chars($ch)" string
	    } else {
		puts stderr "Unknown international character '$ch'"
	    }
	}
	set state(intl) 0
    }

    switch $state(textState) {
	REF { 
	    if {$state(inTP) == 0} {
		set string [insertRef $string]
	    }
	}
	SEE { 
	    global topics curPkg curSect
	    foreach i [split $string] {
		if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
		    continue
		}
		if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} {
		    regsub $i $string [link $i $ref] string
		}
	    }
	}
	KEY {
	    return
	}
    }
    puts -nonewline $file "$string"
}



# insertRef --
#
# This procedure looks for a string in the cross reference table and
# generates a hot-link to the appropriate topic.  Tries to find the
# nearest reference in the manual.
#
# Arguments:
# string -		Text to output in the state(paragraph).

proc insertRef {string} {
    global NAME_file curPkg curSect topics curID
    set path {}
    set string [string trim $string]
    set ref {}
    if {[info exists topics($curPkg,$curSect,$string)]} {
	set ref $topics($curPkg,$curSect,$string)
    } else {
	set sites [array names topics "$curPkg,*,$string"]
	set count [llength $sites]
	if {$count > 0} {
	    set ref $topics([lindex $sites 0])
	} else {
	    set sites [array names topics "*,*,$string"]
	    set count [llength $sites]
	    if {$count > 0} {
		set ref $topics([lindex $sites 0])
	    }
	}
    }

    if {($ref != {}) && ($ref != $curID)} {
	set string [link $string $ref]
    }
    return $string
}



# 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} {
    global state file
    switch $name {
	AP {
	    if {[llength $args] != 3 && [llength $args] != 2} {
		puts stderr "Bad .AP macro: .$name [join $args " "]"
	    }
	    newPara 3.75i -3.75i
	    setTabs {1.25i 2.5i 3.75i}
	    font B
	    text [lindex $args 0]
	    tab
	    font I
	    text [lindex $args 1]
	    tab
	    font R
	    if {[llength $args] == 3} {
		text "([lindex $args 2])"
	    }
	    tab
	}
	AS {
	    # next page and previous page
	}
	br {
	    lineBreak	
	}
	BS {}
	BE {}
	CE {
	    puts -nonewline $::file "\\f0\\fs20 "
	    set state(noFill) 0
	    set state(breakPending) 0
	    newPara ""
	    set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}]
	    set state(sb) 80
	}
	CS {
	    # code section
	    set state(noFill) 1
	    newPara ""
	    set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}]
	    set state(sb) 80
	    puts -nonewline $::file "\\f1\\fs18 "
	}
	DE {
	    set state(noFill) 0
	    decrNestingLevel
	    newPara 0i
	}
	DS {
	    set state(noFill) 1
	    incrNestingLevel
	    newPara 0i
	}
	fi {
	    set state(noFill) 0
	}
	IP {
	    IPmacro $args
	}
	LP {
	    newPara 0i
	    set state(sb) 80
	}
	ne {
	}
	nf {
	    set state(noFill) 1
	}
	OP {
	    if {[llength $args] != 3} {
		puts stderr "Bad .OP macro: .$name [join $args " "]"
	    }
	    set state(nestingLevel) 0
	    newPara 0i
	    set state(sb) 120
	    setTabs 4c
	    text "Command-Line Name:"
	    tab
	    font B
	    set x [lindex $args 0]
	    regsub -all {\\-} $x - x
	    text $x
	    lineBreak
	    font R
	    text "Database Name:"
	    tab
	    font B
	    text [lindex $args 1]
	    lineBreak
	    font R
	    text "Database Class:"
	    tab
	    font B
	    text [lindex $args 2]
	    font R
	    set state(inTP) 0
	    newPara 0.5i
	    set state(sb) 80
	}
	PP {
	    newPara 0i
	    set state(sb) 120
	}
	RE {
	    decrNestingLevel
	}
	RS {
	    incrNestingLevel
	}
	SE {
	    font R
	    set state(noFill) 0
	    set state(nestingLevel) 0
	    newPara 0i
	    text "See the "
	    font B
	    set temp $state(textState)
	    set state(textState) REF
	    text options
	    set state(textState) $temp
	    font R
	    text " manual entry for detailed descriptions of the above options."
	}
	SH {
	    SHmacro $args
	}
	SO {
	    SHmacro "STANDARD OPTIONS"
	    set state(nestingLevel) 0
	    newPara 0i
	    setTabs {4c 8c 12c}
	    font B
	    set state(noFill) 1
	}
	so {
	    if {$args != "man.macros"} {
		puts stderr "Unknown macro: .$name [join $args " "]"
	    }
	}
	sp {					;# needs work
	    if {$args == ""} {
		set count 1
	    } else {
		set count [lindex $args 0]
	    }
	    while {$count > 0} {
		lineBreak
		incr count -1
	    }
	}
	ta {
	    setTabs $args
	}
	TH {
	    THmacro $args
	}
	TP {
	    TPmacro $args
	}
	UL {					;# underline
	    puts -nonewline $file "{\\ul "
	    text [lindex $args 0]
	    puts -nonewline $file "}"
	    if {[llength $args] == 2} {
		text [lindex $args 1]
	    }
	}
	VE {}
	VS {}
	default {
	    puts stderr "Unknown macro: .$name [join $args " "]"
	}
    }
}


# link --
#
# This procedure returns the string for  a hot link to a different
# context location.
#
# Arguments:
# label -		String to display in hot-spot.
# id -			Context string to jump to.

proc link {label id} {
    return "{\\uldb $label}{\\v $id}"
}


# font --
#
# This procedure is invoked to handle font changes in the text
# being output.
#
# Arguments:
# type -		Type of font: R, I, B, or S.

proc font {type} {
    global state
    switch $type {
	P -
	R {
	    endFont
	    if {$state(textState) == "REF"} {
		set state(textState) INSERT
	    }
	}
	C -
	B {
	    beginFont Code
	    if {$state(textState) == "INSERT"} {
		set state(textState) REF
	    }
	}
	I {
	    beginFont Emphasis
	}
	S {
	}
	default {
	    puts stderr "Unknown font: $type"
	}
    }
}



# formattedText --
#
# Insert a text string that may also have \fB-style font changes
# and a few other backslash sequences in it.
#
# Arguments:
# text -		Text to insert.

proc formattedText {text} {
    global chars

    while {$text != ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text "\\"
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    o {
		text "\\'"
		regexp {'([^']*)'(.*)} $text all ch text
		text $chars($ch)
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}


# dash --
#
# This procedure is invoked to handle dash characters ("\-" in
# troff).  It outputs a special dash character.
#
# Arguments:
# None.

proc dash {} {
    global state
    if {[string equal $state(textState) "NAME"]} {
    	set state(textState) 0
    }
    text "-"
}


# tab --
#
# This procedure is invoked to handle tabs in the troff input.
# Right now it does nothing.
#
# Arguments:
# None.

proc tab {} {
    global file

    textSetup
    puts -nonewline $file "\\tab "
}


# setTabs --
#
# This procedure handles the ".ta" macro, which sets tab stops.
#
# Arguments:
# tabList -	List of tab stops, each consisting of a number
#			followed by "i" (inch) or "c" (cm).

proc setTabs {tabList} {
    global file state

    set state(tabs) {}
    foreach arg $tabList {
	set distance [expr {$state(leftMargin) \
		+ ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}]
	lappend state(tabs) [expr {round($distance)}]
    }
}



# lineBreak --
#
# Generates a line break in the HTML output.
#
# Arguments:
# None.

proc lineBreak {} {
    global state
    textSetup
    set state(breakPending) 1
}



# newline --
#
# This procedure is invoked to handle newlines in the troff input.
# It outputs either a space character or a newline character, depending
# on fill mode.
#
# Arguments:
# None.

proc newline {} {
    global state

    if {$state(inTP)} {
    	set state(inTP) 0
	lineBreak
    } elseif {$state(noFill)} {
	lineBreak
    } else {
	text " "
    }
}


# pageBreak --
#
# This procedure is invoked to generate a page break.
#
# Arguments:
# None.

proc pageBreak {} {
    global file curVer
    if {[string equal $curVer ""]} {
	puts $file {\page}
    } else {
	puts $file {\par}
	puts $file {\pard\sb400\qc}
	puts $file "Last change: $curVer\\page"
    }
}


# char --
#
# This procedure is called to handle a special character.
#
# Arguments:
# name -		Special character named in troff \x or \(xx construct.

proc char {name} {
    global file state

    switch -exact $name {
        \\o {
	    set state(intl) 1
	}
	\\\  {
	    textSetup
	    puts -nonewline $file " "
	}
	\\0 {
	    textSetup
	    puts -nonewline $file " \\emspace "
	}
	\\\\ {
	    textSetup
	    puts -nonewline $file "\\\\"
	}
	\\(+- {
	    textSetup
	    puts -nonewline $file "\\'b1 "
	}
	\\% -
	\\| {
	}
	\\(bu {
	    textSetup
	    puts -nonewline $file "