diff options
Diffstat (limited to 'tools/man2help2.tcl')
| -rw-r--r-- | tools/man2help2.tcl | 327 |
1 files changed, 199 insertions, 128 deletions
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index dce162f..9c8f503 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -8,14 +8,11 @@ # # 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.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. # @@ -60,6 +57,7 @@ proc initGlobals {} { 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 @@ -82,7 +80,7 @@ proc beginFont {font} { global file state textSetup - if {$state(curFont) == $font} { + if {[string equal $state(curFont) $font]} { return } endFont @@ -101,7 +99,7 @@ proc beginFont {font} { proc endFont {} { global state file - if {$state(curFont) != ""} { + if {[string compare $state(curFont) ""]} { puts -nonewline $file $state(end$state(curFont)) set state(curFont) "" } @@ -125,6 +123,14 @@ proc textSetup {} { 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 @@ -144,14 +150,19 @@ proc text {string} { global file state chars textSetup - regsub -all "(\[\\\\\{\}\])" $string {\\\1} string - regsub -all { } $string {\\tab } string - regsub -all '' $string \" string - regsub -all `` $string \" 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. + set string [string map [list \ + "\\" "\\\\" \ + "\{" "\\\{" \ + "\}" "\\\}" \ + "\t" {\tab } \ + '' "\\rdblquote " \ + `` "\\ldblquote " \ + "\u00b7" "\\bullet " \ + ] $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]} { @@ -165,18 +176,18 @@ proc text {string} { } switch $state(textState) { - REF { + REF { if {$state(inTP) == 0} { set string [insertRef $string] } } - SEE { + SEE { global topics curPkg curSect foreach i [split $string] { - if ![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ] { + if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} { continue } - if ![catch {set ref $topics($curPkg,$curSect,$i)} ] { + if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} { regsub $i $string [link $i $ref] string } } @@ -204,7 +215,7 @@ proc insertRef {string} { set path {} set string [string trim $string] set ref {} - if [info exists topics($curPkg,$curSect,$string)] { + if {[info exists topics($curPkg,$curSect,$string)]} { set ref $topics($curPkg,$curSect,$string) } else { set sites [array names topics "$curPkg,*,$string"] @@ -220,7 +231,7 @@ proc insertRef {string} { } } - if {([string compare $ref {}] != 0) && ($ref != $curID)} { + if {($ref != "") && ($ref != $curID)} { set string [link $string $ref] } return $string @@ -258,22 +269,29 @@ proc macro {name args} { } tab } - AS {} ;# next page and previous page + AS { + # next page and previous page + } br { - lineBreak + lineBreak } BS {} BE {} CE { - decrNestingLevel + puts -nonewline $::file "\\f0\\fs20 " set state(noFill) 0 set state(breakPending) 0 - newPara 0i + newPara "" + set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}] + set state(sb) 80 } - CS { ;# code section - incrNestingLevel + CS { + # code section set state(noFill) 1 - newPara 0i + newPara "" + set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}] + set state(sb) 80 + puts -nonewline $::file "\\f1\\fs18 " } DE { set state(noFill) 0 @@ -293,6 +311,7 @@ proc macro {name args} { } LP { newPara 0i + set state(sb) 80 } ne { } @@ -304,8 +323,8 @@ proc macro {name args} { puts stderr "Bad .OP macro: .$name [join $args " "]" } set state(nestingLevel) 0 - set state(breakPending) 1 newPara 0i + set state(sb) 120 setTabs 4c text "Command-Line Name:" tab @@ -328,11 +347,11 @@ proc macro {name args} { font R set state(inTP) 0 newPara 0.5i - set state(breakPending) 1 + set state(sb) 80 } PP { - set state(breakPending) 1 newPara 0i + set state(sb) 120 } RE { decrNestingLevel @@ -357,6 +376,9 @@ proc macro {name args} { SH { SHmacro $args } + SS { + SHmacro $args subsection + } SO { SHmacro "STANDARD OPTIONS" set state(nestingLevel) 0 @@ -366,12 +388,12 @@ proc macro {name args} { set state(noFill) 1 } so { - if {$args != "man.macros"} { + if {$args ne "man.macros"} { puts stderr "Unknown macro: .$name [join $args " "]" } } sp { ;# needs work - if {$args == ""} { + if {$args eq ""} { set count 1 } else { set count [lindex $args 0] @@ -400,6 +422,21 @@ proc macro {name args} { } VE {} VS {} + QW { + formattedText "``[lindex $args 0]''[lindex $args 1] " + } + MT { + text "``'' " + } + PQ { + formattedText \ + "(``[lindex $args 0]''[lindex $args 1])[lindex $args 2] " + } + QR { + formattedText "``[lindex $args 0]" + dash + formattedText "[lindex $args 1]''[lindex $args 2] " + } default { puts stderr "Unknown macro: .$name [join $args " "]" } @@ -435,14 +472,14 @@ proc font {type} { P - R { endFont - if {$state(textState) == "REF"} { + if {$state(textState) eq "REF"} { set state(textState) INSERT } } C - B { beginFont Code - if {$state(textState) == "INSERT"} { + if {$state(textState) eq "INSERT"} { set state(textState) REF } } @@ -470,45 +507,43 @@ proc font {type} { proc formattedText {text} { global chars - while {$text != ""} { + while {$text ne ""} { 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]] + 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] + 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] + 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] } - | { - 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) + ( { + char [string range $text $index [expr {$index+3}]] + set text [string range $text [expr {$index+4}] end] } default { puts stderr "Unknown sequence: \\$c" - set text [string range $text [expr $index+2] end] + set text [string range $text [expr {$index+2}] end] } } } } - # dash -- # # This procedure is invoked to handle dash characters ("\-" in @@ -519,7 +554,7 @@ proc formattedText {text} { proc dash {} { global state - if {$state(textState) == "NAME"} { + if {[string equal $state(textState) "NAME"]} { set state(textState) 0 } text "-" @@ -547,22 +582,32 @@ proc tab {} { # 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). +# tabList - List of tab stops in *roff format proc setTabs {tabList} { global file state + set state(tabs) {} foreach arg $tabList { - set distance [expr $state(leftMargin) \ - + $state(offset) * $state(nestingLevel) \ - + [getTwips $arg]] - puts $file [format "\\tx%.0f" [expr round($distance)]] + if {[string match +* $arg]} { + set relativeTo [lindex $state(tabs) end] + set arg [string range $arg 1 end] + } else { + # Local left margin + set relativeTo [expr {$state(leftMargin) \ + + ($state(offset) * $state(nestingLevel))}] + } + if {[regexp {^\\w'([^']*)'u$} $arg -> submatch]} { + # Magic factor! + set distance [expr {[string length $submatch] * 86.4}] + } else { + set distance [getTwips $arg] + } + lappend state(tabs) [expr {round($distance + $relativeTo)}] } } - # lineBreak -- # # Generates a line break in the HTML output. @@ -590,10 +635,10 @@ proc lineBreak {} { proc newline {} { global state - if $state(inTP) { + if {$state(inTP)} { set state(inTP) 0 lineBreak - } elseif $state(noFill) { + } elseif {$state(noFill)} { lineBreak } else { text " " @@ -609,8 +654,14 @@ proc newline {} { # None. proc pageBreak {} { - global file - puts $file "\\page" + 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" + } } @@ -625,31 +676,54 @@ proc char {name} { global file state switch -exact $name { - \\o { + {\o} { set state(intl) 1 } - \\\ { + {\ } { textSetup puts -nonewline $file " " } - \\0 { + {\0} { textSetup puts -nonewline $file " \\emspace " } - \\\\ { + {\\} - {\e} { textSetup puts -nonewline $file "\\\\" } - \\(+- { + {\(+-} { textSetup puts -nonewline $file "\\'b1 " } - \\% - - \\| { + {\%} - {\|} { + } + {\(->} { + textSetup + puts -nonewline $file "->" + } + {\(bu} { + textSetup + puts -nonewline $file "\\bullet " + } + {\(co} { + textSetup + puts -nonewline $file "\\'a9 " + } + {\(mi} { + textSetup + puts -nonewline $file "-" + } + {\(mu} { + textSetup + puts -nonewline $file "\\'d7 " + } + {\(em} - {\(en} { + textSetup + puts -nonewline $file "-" } - \\(bu { + {\(fm} { textSetup - puts -nonewline $file "·" + puts -nonewline $file "\\'27 " } default { puts stderr "Unknown character: $name" @@ -676,21 +750,21 @@ proc macro2 {name args} { # SHmacro -- # -# Subsection head; handles the .SH macro. +# Subsection head; handles the .SH and .SS macros. # # Arguments: # name - Section name. -proc SHmacro {argList} { +proc SHmacro {argList {style section}} { global file state set args [join $argList " "] if {[llength $argList] < 1} { - puts stderr "Bad .SH macro: .$name $args" + 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} @@ -706,26 +780,28 @@ proc SHmacro {argList} { set state(breakPending) 0 } set state(noFill) 0 - nextPara 0i + if {[string compare "subsection" $style] == 0} { + nextPara .25i + } else { + 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 [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 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". +# indent and tab stop based on "count", and tab after +# "text". # # Arguments: # argList - List of arguments to the .IP macro. @@ -736,39 +812,28 @@ proc IPmacro {argList} { global file state set length [llength $argList] - if {$length == 0} { - newPara 0.5i - return + foreach {text indent} $argList break + if {$length > 2} { + puts stderr "Bad .IP macro: .IP [join $argList " "]" } - if {$length == 1} { - set arg [lindex $argList 0] - if {$arg == {[1]}} { - newPara 0.5i - return - } - if {[regexp {^\[[0-9]*\]$} $arg] == 1} { - newPara 0.5i - return - } - newPara 0.5i -0.5i - setTabs 0.5i - formattedText [lindex $argList 0] - tab - return + + if {$length == 0} { + set text {\(bu} + set indent 5 + } elseif {$length == 1} { + set indent 5 } - if {$length == 2} { - set count [lindex $argList 1] - set tab [expr $count * 0.1]i - newPara $tab -$tab - textSetup - setTabs $tab - formattedText [lindex $argList 0] - tab - return + if {$text == {\(bu}} { + set text "\u00b7" } - puts stderr "Bad .IP macro: .IP [join $argList " "]" -} + set tab [expr $indent * 0.1]i + newPara $tab -$tab + set state(sb) 80 + setTabs $tab + formattedText $text + tab +} # TPmacro -- # @@ -785,23 +850,21 @@ proc IPmacro {argList} { # # 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 + set val [expr {([lindex $argList 0] * 100.0)/1440}]i } newPara $val -$val setTabs $val set state(inTP) 1 - set state(breakPending) 1 + set state(sb) 120 } - # THmacro -- # # This procedure handles the .TH macro. It generates the non-scrolling @@ -814,19 +877,19 @@ proc TPmacro {argList} { # argList - List of arguments to the .TH macro. proc THmacro {argList} { - global file curPkg curSect curID id_keywords state + global file curPkg curSect curID id_keywords state curVer bitmap if {[llength $argList] != 5} { set args [join $argList " "] - puts stderr "Bad .TH macro: .$name $args" + puts stderr "Bad .TH macro: .TH $args" } incr curID set name [lindex $argList 0] ;# Tcl_UpVar set page [lindex $argList 1] ;# 3 - set vers [lindex $argList 2] ;# 7.4 + 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 @@ -852,6 +915,10 @@ proc THmacro {argList} { tab text $curSect font R + if {[info exists bitmap]} { + # a right justified bitmap + puts $file "\\\{bmrt $bitmap\\\}" + } puts $file "\\fs20" set state(breakPending) -1 } @@ -887,15 +954,16 @@ proc newPara {leftIndent {firstIndent 0i}} { if $state(paragraph) { puts -nonewline $file "\\line\n" } - set state(leftIndent) [expr $state(leftMargin) \ - + $state(offset) * $state(nestingLevel) \ - + [getTwips $leftIndent]] + if {$leftIndent ne ""} { + 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 @@ -909,16 +977,20 @@ proc getTwips {arg} { puts stderr "bad distance \"$arg\"" return 0 } + if {[string length $units] > 1} { + puts stderr "additional characters after unit \"$arg\"" + set units [string index $units 0] + } switch -- $units { c { - set distance [expr $distance * 567] + set distance [expr {$distance * 567}] } i { - set distance [expr $distance * 1440] + set distance [expr {$distance * 1440}] } default { puts stderr "bad units in distance \"$arg\"" - continue + return 0 } } return $distance @@ -952,11 +1024,10 @@ proc incrNestingLevel {} { proc decrNestingLevel {} { global state - + if {$state(nestingLevel) == 0} { puts stderr "Nesting level decremented below 0" } else { incr state(nestingLevel) -1 } } - |