# 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

    }

}