diff options
Diffstat (limited to 'tools/man2help2.tcl')
| -rw-r--r-- | tools/man2help2.tcl | 188 |
1 files changed, 119 insertions, 69 deletions
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index df2678c..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.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. # @@ -160,6 +157,7 @@ proc text {string} { "\t" {\tab } \ '' "\\rdblquote " \ `` "\\ldblquote " \ + "\u00b7" "\\bullet " \ ] $string] # Check if this is the beginning of an international character string. @@ -178,12 +176,12 @@ 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 ]} { @@ -233,7 +231,7 @@ proc insertRef {string} { } } - if {($ref != {}) && ($ref != $curID)} { + if {($ref != "") && ($ref != $curID)} { set string [link $string $ref] } return $string @@ -275,7 +273,7 @@ proc macro {name args} { # next page and previous page } br { - lineBreak + lineBreak } BS {} BE {} @@ -378,6 +376,9 @@ proc macro {name args} { SH { SHmacro $args } + SS { + SHmacro $args subsection + } SO { SHmacro "STANDARD OPTIONS" set state(nestingLevel) 0 @@ -387,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] @@ -421,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 " "]" } @@ -456,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 } } @@ -491,7 +507,7 @@ proc font {type} { proc formattedText {text} { global chars - while {$text != ""} { + while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text @@ -512,13 +528,12 @@ proc formattedText {text} { 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) + ( { + char [string range $text $index [expr {$index+3}]] + set text [string range $text [expr {$index+4}] end] } default { puts stderr "Unknown sequence: \\$c" @@ -567,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]}] - lappend state(tabs) [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. @@ -651,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" @@ -702,12 +750,12 @@ 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 " "] @@ -716,7 +764,7 @@ proc SHmacro {argList} { } # control what the text proc does with text - + switch $args { NAME {set state(textState) NAME} DESCRIPTION {set state(textState) INSERT} @@ -732,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. @@ -762,31 +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} { - newPara 0.5i -0.5i - set state(sb) 80 - 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 - set state(sb) 80 - 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 -- # @@ -842,7 +889,7 @@ proc THmacro {argList} { 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 @@ -907,7 +954,7 @@ proc newPara {leftIndent {firstIndent 0i}} { if $state(paragraph) { puts -nonewline $file "\\line\n" } - if {$leftIndent != ""} { + if {$leftIndent ne ""} { set state(leftIndent) [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel)) \ + [getTwips $leftIndent]}] @@ -930,6 +977,10 @@ 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}] @@ -939,7 +990,7 @@ proc getTwips {arg} { } default { puts stderr "bad units in distance \"$arg\"" - continue + return 0 } } return $distance @@ -973,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 } } - |