man2html2.tcl

tcl是工具命令语言

# man2html2.tcl --
#
# This file defines procedures that are used during the second pass of the
# man page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# SCCS: @(#) man2html2.tcl 1.2 96/03/21 10:48:30
#

# Global variables used by these scripts:
#
# NAME_file -	array indexed by NAME and containing file names used
#		for hyperlinks.
#
# textState -	state variable defining action of 'text' proc.
#
# nestStk -	stack oriented list containing currently active
#		HTML tags (UL, OL, DL). Local to 'nest' proc.
#
# inDT -	set by 'TPmacro', cleared by 'newline'. Used to insert
#		the <DT> tag while in a dictionary list <DL>.
#
# curFont -	Name of special font that is currently in
#		use.  Null means the default paragraph font
#		is being used.
#
# file -	Where to output the generated HTML.
#
# fontStart -	Array to map font names to starting sequences.
#
# fontEnd -	Array to map font names to ending sequences.
#
# noFillCount -	Non-zero means don't fill the next $noFillCount
#		lines: force a line break at each newline.  Zero
#		means filling is enabled, so don't output line
#		breaks for each newline.
#
# footer -	info inserted at bottom of each page. Normally read
#		from the xref.tcl file
	
# 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 {} {
    global file noFillCount textState
    global fontStart fontEnd curFont inPRE charCnt

    nest init
    set inPRE 0
    set textState 0
    set curFont ""
    set fontStart(Code) "<B>"
    set fontStart(Emphasis) "<I>"
    set fontEnd(Code) "</B>"
    set fontEnd(Emphasis) "</I>"
    set noFillCount 0
    set charCnt 0
    setTabs 0.5i
}


# 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 curFont file fontStart

    if {$curFont == $font} {
	return
    }
    endFont
    puts -nonewline $file $fontStart($font)
    set curFont $font
}


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

proc endFont {} {
    global curFont file fontEnd

    if {$curFont != ""} {
    puts -nonewline $file $fontEnd($curFont)
    set curFont ""
    }
}



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

proc text string {
    global file textState inDT charCnt

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr $pos-1]]
    	tab
    	text [string range $string [expr $pos+1] end]
	return    	
    }
    incr charCnt [string length $string]
    regsub -all {&} $string {\&amp;}  string
    regsub -all {<} $string {\&lt;}  string
    regsub -all {>} $string {\&gt;}  string
    regsub -all {"} $string {\&quot;}  string
    switch $textState {
	REF { 
	    if {$inDT == {}} {
		set string [insertRef $string]
	    }
	}
	SEE { 
	    global NAME_file
	    foreach i [split $string] {
		if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] {
# 		    puts "Warning: $i in SEE ALSO not found"
		    continue
		}
		if ![catch {set ref $NAME_file($i)} ] {
		    regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
		}
	    }
	}
    }
    puts -nonewline $file "$string"
}



# insertRef --
#
#
# Arguments:
# string -		Text to output in the paragraph.

proc insertRef string {
    global NAME_file self
    set path {}
    if ![catch {set ref $NAME_file([string trim $string])} ] {
	if {"$ref.html" != $self} {
	    set string "<A HREF=\"${path}$ref.html\">$string</A>"
#	    puts "insertRef: $self $ref.html ---$string--"
	}
    }
    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} {
    switch $name {
	AP {
	    if {[llength $args] != 3} {
		puts stderr "Bad .AP macro: .$name [join $args " "]"
	    }
	    setTabs {1.25i 2.5i 3.75i}
	    TPmacro {}
	    font B
	    text "[lindex $args 0]  "
	    font I
	    text "[lindex $args 1]"
	    font R
	    text " ([lindex $args 2])"
	    newline
	}
	AS {}				;# next page and previous page
	br {
	    lineBreak	
	}
	BS {}
	BE {}
	CE {
	    global file noFillCount inPRE
	    puts $file </PRE></BLOCKQUOTE>
	    set inPRE 0
	}
	CS {				;# code section
	    global file noFillCount inPRE
	    puts -nonewline $file <BLOCKQUOTE><PRE>
	    set inPRE 1
	}
	DE {
	    global file noFillCount inPRE
	    puts $file </PRE></BLOCKQUOTE>
	    set inPRE 0
	    set noFillCount 0
	}
	DS {
	    global file noFillCount inPRE
	    puts -nonewline $file <BLOCKQUOTE><PRE>
	    set noFillCount 10000000
	    set inPRE 1
	}
	fi {
	    global noFillCount
	    set noFillCount 0
	}
	IP {
	    IPmacro $args
	}
	LP {
	    nest decr
	    nest incr
	    newPara
	}
	ne {
	}
	nf {
	    global noFillCount
	    set noFillCount 1000000
	}
	OP {
	    global inDT file inPRE 
	    if {[llength $args] != 3} {
		puts stderr "Bad .OP macro: .$name [join $args " "]"
	    }
	    nest para DL DT
	    set inPRE 1
	    puts -nonewline $file <PRE>				
	    setTabs 4c
	    text "Command-Line Name:"
	    tab
	    font B
	    set x [lindex $args 0]
	    regsub -all {\\-} $x - x
	    text $x
	    newline
	    font R
	    text "Database Name:"
	    tab
	    font B
	    text [lindex $args 1]
	    newline
	    font R
	    text "Database Class:"
	    tab
	    font B
	    text [lindex $args 2]
	    font R
	    puts -nonewline $file </PRE>				
	    set inDT "\n<DD>"			;# next newline writes inDT 
	    set inPRE 0
	    newline
	}
	PP {
	    nest decr
	    nest incr
	    newPara
	}
	RE {
	    nest decr    
	}
	RS {
	    nest incr
	}
	SE {
	    global noFillCount textState inPRE file

	    font R
	    puts -nonewline $file </PRE>
	    set inPRE 0
	    set noFillCount 0
	    nest reset
	    newPara
	    text "See the "
	    font B
	    set temp $textState
	    set textState REF
	    text options
	    set textState $temp
	    font R
	    text " manual entry for detailed descriptions of the above options."
	}
	SH {
	    SHmacro $args
	}
	SO {
	    global noFillCount inPRE file

	    SHmacro "STANDARD OPTIONS"
	    setTabs {4c 8c 12c}
	    set noFillCount 1000000
	    puts -nonewline $file <PRE>
	    set inPRE 1
	    font B
	}
	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
	    global file
	    puts -nonewline $file "<B><U>"
	    text [lindex $args 0]
	    puts -nonewline $file "</U></B>"
	    if {[llength $args] == 2} {
		text [lindex $args 1]
	    }
	}
	VE {
#	    global file
#	    puts -nonewline $file "</FONT>"
	}
	VS {
#	    global file
#	    if {[llength $args] > 0} {
#		puts -nonewline $file "<BR>"
#	    }
#	    puts -nonewline $file "<FONT COLOR=\"GREEN\">"
	}
	default {
	    puts stderr "Unknown macro: .$name [join $args " "]"
	}
    }

#	global nestStk; puts "$name [format "%-20s" $args] $nestStk"
#	flush stdout; flush stderr
}


# 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 textState
    switch $type {
	P -
	R {
	    endFont
	    if {$textState == "REF"} {
		set textState INSERT
	    }
	}
	B {
	    beginFont Code
	    if {$textState == "INSERT"} {
		set 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 {
#	puts "formattedText: $text"
    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 \\