# 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 "·"

 	}

 	default {

 	    puts stderr "Unknown character: $name"

 	}

     }

 }

 # macro2 --

 #

 # This procedure handles macros that are invoked with a leading "'"

 # character instead of space.  Right now it just generates an

 # error diagnostic.

 #

 # Arguments:

 # name -		The name of the macro (without the ".").

 # args -		Any additional arguments to the macro.

 proc macro2 {name args} {

     puts stderr "Unknown macro: '$name [join $args " "]"

 }

 # SHmacro --

 #

 # Subsection head; handles the .SH macro.

 #

 # Arguments:

 # name -		Section name.

 proc SHmacro {argList} {

     global file state

     set args [join $argList " "]

     if {[llength $argList] < 1} {

 	puts stderr "Bad .SH macro: .SH $args"

     }

     # control what the text proc does with text

     switch $args {

 	NAME {set state(textState) NAME}

 	DESCRIPTION {set state(textState) INSERT}

 	INTRODUCTION {set state(textState) INSERT}

 	"WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT}

 	"SEE ALSO" {set state(textState) SEE}

 	KEYWORDS {set state(textState) KEY; return}

     }

     if {$state(breakPending) != -1} {

 	set state(breakPending) 1

     } else {

 	set state(breakPending) 0

     }

     set state(noFill) 0

     nextPara 0i

     font B

     text $args

     font R

     nextPara .5i

 }

 # IPmacro --

 #

 # This procedure is invoked to handle ".IP" macros, which may take any

 # of the following forms:

 #

 # .IP [1]			Translate to a "1Step" state(paragraph).

 # .IP [x] (x > 1)	Translate to a "Step" state(paragraph).

 # .IP				Translate to a "Bullet" state(paragraph).

 # .IP text count	Translate to a FirstBody state(paragraph) with special

 #					indent and tab stop based on "count", and tab after

 #					"text".

 #

 # Arguments:

 # argList -		List of arguments to the .IP macro.

 #

 # HTML limitations: 'count' in '.IP text count' is ignored.

 proc IPmacro {argList} {

     global file state

     set length [llength $argList]

     if {$length == 0} {

 	newPara 0.5i

 	return

     }

     if {$length == 1} {

 	newPara 0.5i -0.5i

 	set state(sb) 80

 	setTabs 0.5i

 	formattedText [lindex $argList 0]

 	tab

 	return

     }

     if {$length == 2} {

 	set count [lindex $argList 1]

 	set tab [expr $count * 0.1]i

 	newPara $tab -$tab

 	set state(sb) 80

 	setTabs $tab

 	formattedText [lindex $argList 0]

 	tab

 	return

     }

     puts stderr "Bad .IP macro: .IP [join $argList " "]"

 }

 # TPmacro --

 #

 # This procedure is invoked to handle ".TP" macros, which may take any

 # of the following forms:

 #

 # .TP x		Translate to an state(indent)ed state(paragraph) with the

 # 			specified state(indent) (in 100 twip units).

 # .TP		Translate to an state(indent)ed state(paragraph) with

 # 			default state(indent).

 #

 # Arguments:

 # argList -		List of arguments to the .IP macro.

 #

 # HTML limitations: 'x' in '.TP x' is ignored.

 proc TPmacro {argList} {

     global state

     set length [llength $argList]

     if {$length == 0} {

 	set val 0.5i

     } else {

 	set val [expr {([lindex $argList 0] * 100.0)/1440}]i

     }

     newPara $val -$val

     setTabs $val

     set state(inTP) 1

     set state(sb) 120

 }

 # THmacro --

 #

 # This procedure handles the .TH macro.  It generates the non-scrolling

 # header section for a given man page, and enters information into the

 # table of contents.  The .TH macro has the following form:

 #

 # .TH name section date footer header

 #

 # Arguments:

 # argList -		List of arguments to the .TH macro.

 proc THmacro {argList} {

     global file curPkg curSect curID id_keywords state curVer bitmap

     if {[llength $argList] != 5} {

 	set args [join $argList " "]

 	puts stderr "Bad .TH macro: .TH $args"

     }

     incr curID

     set name	[lindex $argList 0]		;# Tcl_UpVar

     set page	[lindex $argList 1]		;# 3

     set curVer	[lindex $argList 2]		;# 7.4

     set curPkg	[lindex $argList 3]		;# Tcl

     set curSect	[lindex $argList 4]		;# {Tcl Library Procedures}

     regsub -all {\\ } $curSect { } curSect	;# Clean up for [incr\ Tcl]

     puts $file "#{\\footnote $curID}"		;# Context string

     puts $file "\${\\footnote $name}"		;# Topic title

     set browse "${curSect}${name}"

     regsub -all {[ _-]} $browse {} browse

     puts $file "+{\\footnote $browse}"		;# Browse sequence

     # Suppress duplicates

     foreach i $id_keywords($curID) {

 	set keys($i) 1

     }

     foreach i [array names keys] {

 	set i [string trim $i]

 	if {[string length $i] > 0} {

 	    puts $file "K{\\footnote $i}"	;# Keyword strings

 	}

     }

     unset keys

     puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn"

     font B

     text $name

     tab

     text $curSect

     font R

     if {[info exists bitmap]} {

 	# a right justified bitmap

 	puts $file "\\\{bmrt $bitmap\\\}"

     }

     puts $file "\\fs20"

     set state(breakPending) -1

 }

 # nextPara --

 #

 # Set the indents for a new paragraph, and start a paragraph break

 #

 # Arguments:

 # leftIndent -		The new left margin for body lines.

 # firstIndent -		The offset from the left margin for the first line.

 proc nextPara {leftIndent {firstIndent 0i}} {

     global state

     set state(leftIndent) [getTwips $leftIndent]

     set state(firstIndent) [getTwips $firstIndent]

     set state(paragraphPending) 1

 }

 # newPara --

 #

 # This procedure sets the left and hanging state(indent)s for a line.

 # State(Indent)s are specified in units of inches or centimeters, and are

 # relative to the current nesting level and left margin.

 #

 # Arguments:

 # leftState(Indent) -		The new left margin for lines after the first.

 # firstState(Indent) -		The new left margin for the first line of a state(paragraph).

 proc newPara {leftIndent {firstIndent 0i}} {

     global state file

     if $state(paragraph) {

 	puts -nonewline $file "\\line\n"

     }

     if {$leftIndent != ""} {

 	set state(leftIndent) [expr {$state(leftMargin) \

 		+ ($state(offset) * $state(nestingLevel)) \

 		+ [getTwips $leftIndent]}]

     }

     set state(firstIndent) [getTwips $firstIndent]

     set state(paragraphPending) 1

 }

 # getTwips --

 #

 # This procedure converts a distance in inches or centimeters into

 # twips (1/1440 of an inch).

 #

 # Arguments:

 # arg -			A number followed by "i" or "c"

 proc getTwips {arg} {

     if {[scan $arg "%f%s" distance units] != 2} {

 	puts stderr "bad distance \"$arg\""

 	return 0

     }

     switch -- $units {

 	c	{

 	    set distance [expr {$distance * 567}]

 	}

 	i	{

 	    set distance [expr {$distance * 1440}]

 	}

 	default {

 	    puts stderr "bad units in distance \"$arg\""

 	    continue

 	}

     }

     return $distance

 }

 # incrNestingLevel --

 #

 # This procedure does the work of the .RS macro, which increments

 # the number of state(indent)ations that affect things like .PP.

 #

 # Arguments:

 # None.

 proc incrNestingLevel {} {

     global state

     incr state(nestingLevel)

     set oldp $state(paragraph)

     set state(paragraph) 0

     newPara 0i

     set state(paragraph) $oldp

 }

 # decrNestingLevel --

 #

 # This procedure does the work of the .RE macro, which decrements

 # the number of indentations that affect things like .PP.

 #

 # Arguments:

 # None.

 proc decrNestingLevel {} {

     global state

     if {$state(nestingLevel) == 0} {

 	puts stderr "Nesting level decremented below 0"

     } else {

 	incr state(nestingLevel) -1

     }

 }