os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2help2.tcl
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2help2.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,983 @@
1.4 +# man2help2.tcl --
1.5 +#
1.6 +# This file defines procedures that are used during the second pass of
1.7 +# the man page conversion. It converts the man format input to rtf
1.8 +# form suitable for use by the Windows help compiler.
1.9 +#
1.10 +# Copyright (c) 1996 by Sun Microsystems, Inc.
1.11 +#
1.12 +# See the file "license.terms" for information on usage and redistribution
1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 +#
1.15 +# RCS: @(#) $Id: man2help2.tcl,v 1.12 2002/10/03 13:34:32 dkf Exp $
1.16 +#
1.17 +
1.18 +# Global variables used by these scripts:
1.19 +#
1.20 +# state - state variable that controls action of text proc.
1.21 +#
1.22 +# topics - array indexed by (package,section,topic) with value
1.23 +# of topic ID.
1.24 +#
1.25 +# keywords - array indexed by keyword string with value of topic ID.
1.26 +#
1.27 +# curID - current topic ID, starts at 0 and is incremented for
1.28 +# each new topic file.
1.29 +#
1.30 +# curPkg - current package name (e.g. Tcl).
1.31 +#
1.32 +# curSect - current section title (e.g. "Tcl Built-In Commands").
1.33 +#
1.34 +
1.35 +# initGlobals --
1.36 +#
1.37 +# This procedure is invoked to set the initial values of all of the
1.38 +# global variables, before processing a man page.
1.39 +#
1.40 +# Arguments:
1.41 +# None.
1.42 +
1.43 +proc initGlobals {} {
1.44 + uplevel \#0 unset state
1.45 + global state chars
1.46 +
1.47 + set state(paragraphPending) 0
1.48 + set state(breakPending) 0
1.49 + set state(firstIndent) 0
1.50 + set state(leftIndent) 0
1.51 +
1.52 + set state(inTP) 0
1.53 + set state(paragraph) 0
1.54 + set state(textState) 0
1.55 + set state(curFont) ""
1.56 + set state(startCode) "{\\b "
1.57 + set state(startEmphasis) "{\\i "
1.58 + set state(endCode) "}"
1.59 + set state(endEmphasis) "}"
1.60 + set state(noFill) 0
1.61 + set state(charCnt) 0
1.62 + set state(offset) [getTwips 0.5i]
1.63 + set state(leftMargin) [getTwips 0.5i]
1.64 + set state(nestingLevel) 0
1.65 + set state(intl) 0
1.66 + set state(sb) 0
1.67 + setTabs 0.5i
1.68 +
1.69 +# set up international character table
1.70 +
1.71 + array set chars {
1.72 + o^ F4
1.73 + }
1.74 +}
1.75 +
1.76 +
1.77 +# beginFont --
1.78 +#
1.79 +# Arranges for future text to use a special font, rather than
1.80 +# the default paragraph font.
1.81 +#
1.82 +# Arguments:
1.83 +# font - Name of new font to use.
1.84 +
1.85 +proc beginFont {font} {
1.86 + global file state
1.87 +
1.88 + textSetup
1.89 + if {[string equal $state(curFont) $font]} {
1.90 + return
1.91 + }
1.92 + endFont
1.93 + puts -nonewline $file $state(start$font)
1.94 + set state(curFont) $font
1.95 +}
1.96 +
1.97 +
1.98 +# endFont --
1.99 +#
1.100 +# Reverts to the default font for the paragraph type.
1.101 +#
1.102 +# Arguments:
1.103 +# None.
1.104 +
1.105 +proc endFont {} {
1.106 + global state file
1.107 +
1.108 + if {[string compare $state(curFont) ""]} {
1.109 + puts -nonewline $file $state(end$state(curFont))
1.110 + set state(curFont) ""
1.111 + }
1.112 +}
1.113 +
1.114 +
1.115 +# textSetup --
1.116 +#
1.117 +# This procedure is called the first time that text is output for a
1.118 +# paragraph. It outputs the header information for the paragraph.
1.119 +#
1.120 +# Arguments:
1.121 +# None.
1.122 +
1.123 +proc textSetup {} {
1.124 + global file state
1.125 +
1.126 + if $state(breakPending) {
1.127 + puts $file "\\line"
1.128 + }
1.129 + if $state(paragraphPending) {
1.130 + puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \
1.131 + $state(firstIndent) $state(leftIndent)]
1.132 + foreach tab $state(tabs) {
1.133 + puts $file [format "\\tx%.0f" $tab]
1.134 + }
1.135 + set state(tabs) {}
1.136 + if {$state(sb)} {
1.137 + puts $file "\\sb$state(sb)"
1.138 + set state(sb) 0
1.139 + }
1.140 + }
1.141 + set state(breakPending) 0
1.142 + set state(paragraphPending) 0
1.143 +}
1.144 +
1.145 +
1.146 +# text --
1.147 +#
1.148 +# This procedure adds text to the current state(paragraph). If this is
1.149 +# the first text in the state(paragraph) then header information for the
1.150 +# state(paragraph) is output before the text.
1.151 +#
1.152 +# Arguments:
1.153 +# string - Text to output in the state(paragraph).
1.154 +
1.155 +proc text {string} {
1.156 + global file state chars
1.157 +
1.158 + textSetup
1.159 + set string [string map [list \
1.160 + "\\" "\\\\" \
1.161 + "\{" "\\\{" \
1.162 + "\}" "\\\}" \
1.163 + "\t" {\tab } \
1.164 + '' "\\rdblquote " \
1.165 + `` "\\ldblquote " \
1.166 + ] $string]
1.167 +
1.168 + # Check if this is the beginning of an international character string.
1.169 + # If so, look up the sequence in the chars table and substitute the
1.170 + # appropriate hex value.
1.171 +
1.172 + if {$state(intl)} {
1.173 + if {[regexp {^'([^']*)'} $string dummy ch]} {
1.174 + if {[info exists chars($ch)]} {
1.175 + regsub {^'[^']*'} $string "\\\\'$chars($ch)" string
1.176 + } else {
1.177 + puts stderr "Unknown international character '$ch'"
1.178 + }
1.179 + }
1.180 + set state(intl) 0
1.181 + }
1.182 +
1.183 + switch $state(textState) {
1.184 + REF {
1.185 + if {$state(inTP) == 0} {
1.186 + set string [insertRef $string]
1.187 + }
1.188 + }
1.189 + SEE {
1.190 + global topics curPkg curSect
1.191 + foreach i [split $string] {
1.192 + if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
1.193 + continue
1.194 + }
1.195 + if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} {
1.196 + regsub $i $string [link $i $ref] string
1.197 + }
1.198 + }
1.199 + }
1.200 + KEY {
1.201 + return
1.202 + }
1.203 + }
1.204 + puts -nonewline $file "$string"
1.205 +}
1.206 +
1.207 +
1.208 +
1.209 +# insertRef --
1.210 +#
1.211 +# This procedure looks for a string in the cross reference table and
1.212 +# generates a hot-link to the appropriate topic. Tries to find the
1.213 +# nearest reference in the manual.
1.214 +#
1.215 +# Arguments:
1.216 +# string - Text to output in the state(paragraph).
1.217 +
1.218 +proc insertRef {string} {
1.219 + global NAME_file curPkg curSect topics curID
1.220 + set path {}
1.221 + set string [string trim $string]
1.222 + set ref {}
1.223 + if {[info exists topics($curPkg,$curSect,$string)]} {
1.224 + set ref $topics($curPkg,$curSect,$string)
1.225 + } else {
1.226 + set sites [array names topics "$curPkg,*,$string"]
1.227 + set count [llength $sites]
1.228 + if {$count > 0} {
1.229 + set ref $topics([lindex $sites 0])
1.230 + } else {
1.231 + set sites [array names topics "*,*,$string"]
1.232 + set count [llength $sites]
1.233 + if {$count > 0} {
1.234 + set ref $topics([lindex $sites 0])
1.235 + }
1.236 + }
1.237 + }
1.238 +
1.239 + if {($ref != {}) && ($ref != $curID)} {
1.240 + set string [link $string $ref]
1.241 + }
1.242 + return $string
1.243 +}
1.244 +
1.245 +
1.246 +
1.247 +# macro --
1.248 +#
1.249 +# This procedure is invoked to process macro invocations that start
1.250 +# with "." (instead of ').
1.251 +#
1.252 +# Arguments:
1.253 +# name - The name of the macro (without the ".").
1.254 +# args - Any additional arguments to the macro.
1.255 +
1.256 +proc macro {name args} {
1.257 + global state file
1.258 + switch $name {
1.259 + AP {
1.260 + if {[llength $args] != 3 && [llength $args] != 2} {
1.261 + puts stderr "Bad .AP macro: .$name [join $args " "]"
1.262 + }
1.263 + newPara 3.75i -3.75i
1.264 + setTabs {1.25i 2.5i 3.75i}
1.265 + font B
1.266 + text [lindex $args 0]
1.267 + tab
1.268 + font I
1.269 + text [lindex $args 1]
1.270 + tab
1.271 + font R
1.272 + if {[llength $args] == 3} {
1.273 + text "([lindex $args 2])"
1.274 + }
1.275 + tab
1.276 + }
1.277 + AS {
1.278 + # next page and previous page
1.279 + }
1.280 + br {
1.281 + lineBreak
1.282 + }
1.283 + BS {}
1.284 + BE {}
1.285 + CE {
1.286 + puts -nonewline $::file "\\f0\\fs20 "
1.287 + set state(noFill) 0
1.288 + set state(breakPending) 0
1.289 + newPara ""
1.290 + set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}]
1.291 + set state(sb) 80
1.292 + }
1.293 + CS {
1.294 + # code section
1.295 + set state(noFill) 1
1.296 + newPara ""
1.297 + set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}]
1.298 + set state(sb) 80
1.299 + puts -nonewline $::file "\\f1\\fs18 "
1.300 + }
1.301 + DE {
1.302 + set state(noFill) 0
1.303 + decrNestingLevel
1.304 + newPara 0i
1.305 + }
1.306 + DS {
1.307 + set state(noFill) 1
1.308 + incrNestingLevel
1.309 + newPara 0i
1.310 + }
1.311 + fi {
1.312 + set state(noFill) 0
1.313 + }
1.314 + IP {
1.315 + IPmacro $args
1.316 + }
1.317 + LP {
1.318 + newPara 0i
1.319 + set state(sb) 80
1.320 + }
1.321 + ne {
1.322 + }
1.323 + nf {
1.324 + set state(noFill) 1
1.325 + }
1.326 + OP {
1.327 + if {[llength $args] != 3} {
1.328 + puts stderr "Bad .OP macro: .$name [join $args " "]"
1.329 + }
1.330 + set state(nestingLevel) 0
1.331 + newPara 0i
1.332 + set state(sb) 120
1.333 + setTabs 4c
1.334 + text "Command-Line Name:"
1.335 + tab
1.336 + font B
1.337 + set x [lindex $args 0]
1.338 + regsub -all {\\-} $x - x
1.339 + text $x
1.340 + lineBreak
1.341 + font R
1.342 + text "Database Name:"
1.343 + tab
1.344 + font B
1.345 + text [lindex $args 1]
1.346 + lineBreak
1.347 + font R
1.348 + text "Database Class:"
1.349 + tab
1.350 + font B
1.351 + text [lindex $args 2]
1.352 + font R
1.353 + set state(inTP) 0
1.354 + newPara 0.5i
1.355 + set state(sb) 80
1.356 + }
1.357 + PP {
1.358 + newPara 0i
1.359 + set state(sb) 120
1.360 + }
1.361 + RE {
1.362 + decrNestingLevel
1.363 + }
1.364 + RS {
1.365 + incrNestingLevel
1.366 + }
1.367 + SE {
1.368 + font R
1.369 + set state(noFill) 0
1.370 + set state(nestingLevel) 0
1.371 + newPara 0i
1.372 + text "See the "
1.373 + font B
1.374 + set temp $state(textState)
1.375 + set state(textState) REF
1.376 + text options
1.377 + set state(textState) $temp
1.378 + font R
1.379 + text " manual entry for detailed descriptions of the above options."
1.380 + }
1.381 + SH {
1.382 + SHmacro $args
1.383 + }
1.384 + SO {
1.385 + SHmacro "STANDARD OPTIONS"
1.386 + set state(nestingLevel) 0
1.387 + newPara 0i
1.388 + setTabs {4c 8c 12c}
1.389 + font B
1.390 + set state(noFill) 1
1.391 + }
1.392 + so {
1.393 + if {$args != "man.macros"} {
1.394 + puts stderr "Unknown macro: .$name [join $args " "]"
1.395 + }
1.396 + }
1.397 + sp { ;# needs work
1.398 + if {$args == ""} {
1.399 + set count 1
1.400 + } else {
1.401 + set count [lindex $args 0]
1.402 + }
1.403 + while {$count > 0} {
1.404 + lineBreak
1.405 + incr count -1
1.406 + }
1.407 + }
1.408 + ta {
1.409 + setTabs $args
1.410 + }
1.411 + TH {
1.412 + THmacro $args
1.413 + }
1.414 + TP {
1.415 + TPmacro $args
1.416 + }
1.417 + UL { ;# underline
1.418 + puts -nonewline $file "{\\ul "
1.419 + text [lindex $args 0]
1.420 + puts -nonewline $file "}"
1.421 + if {[llength $args] == 2} {
1.422 + text [lindex $args 1]
1.423 + }
1.424 + }
1.425 + VE {}
1.426 + VS {}
1.427 + default {
1.428 + puts stderr "Unknown macro: .$name [join $args " "]"
1.429 + }
1.430 + }
1.431 +}
1.432 +
1.433 +
1.434 +# link --
1.435 +#
1.436 +# This procedure returns the string for a hot link to a different
1.437 +# context location.
1.438 +#
1.439 +# Arguments:
1.440 +# label - String to display in hot-spot.
1.441 +# id - Context string to jump to.
1.442 +
1.443 +proc link {label id} {
1.444 + return "{\\uldb $label}{\\v $id}"
1.445 +}
1.446 +
1.447 +
1.448 +# font --
1.449 +#
1.450 +# This procedure is invoked to handle font changes in the text
1.451 +# being output.
1.452 +#
1.453 +# Arguments:
1.454 +# type - Type of font: R, I, B, or S.
1.455 +
1.456 +proc font {type} {
1.457 + global state
1.458 + switch $type {
1.459 + P -
1.460 + R {
1.461 + endFont
1.462 + if {$state(textState) == "REF"} {
1.463 + set state(textState) INSERT
1.464 + }
1.465 + }
1.466 + C -
1.467 + B {
1.468 + beginFont Code
1.469 + if {$state(textState) == "INSERT"} {
1.470 + set state(textState) REF
1.471 + }
1.472 + }
1.473 + I {
1.474 + beginFont Emphasis
1.475 + }
1.476 + S {
1.477 + }
1.478 + default {
1.479 + puts stderr "Unknown font: $type"
1.480 + }
1.481 + }
1.482 +}
1.483 +
1.484 +
1.485 +
1.486 +# formattedText --
1.487 +#
1.488 +# Insert a text string that may also have \fB-style font changes
1.489 +# and a few other backslash sequences in it.
1.490 +#
1.491 +# Arguments:
1.492 +# text - Text to insert.
1.493 +
1.494 +proc formattedText {text} {
1.495 + global chars
1.496 +
1.497 + while {$text != ""} {
1.498 + set index [string first \\ $text]
1.499 + if {$index < 0} {
1.500 + text $text
1.501 + return
1.502 + }
1.503 + text [string range $text 0 [expr {$index-1}]]
1.504 + set c [string index $text [expr {$index+1}]]
1.505 + switch -- $c {
1.506 + f {
1.507 + font [string index $text [expr {$index+2}]]
1.508 + set text [string range $text [expr {$index+3}] end]
1.509 + }
1.510 + e {
1.511 + text "\\"
1.512 + set text [string range $text [expr {$index+2}] end]
1.513 + }
1.514 + - {
1.515 + dash
1.516 + set text [string range $text [expr {$index+2}] end]
1.517 + }
1.518 + | {
1.519 + set text [string range $text [expr {$index+2}] end]
1.520 + }
1.521 + o {
1.522 + text "\\'"
1.523 + regexp {'([^']*)'(.*)} $text all ch text
1.524 + text $chars($ch)
1.525 + }
1.526 + default {
1.527 + puts stderr "Unknown sequence: \\$c"
1.528 + set text [string range $text [expr {$index+2}] end]
1.529 + }
1.530 + }
1.531 + }
1.532 +}
1.533 +
1.534 +
1.535 +# dash --
1.536 +#
1.537 +# This procedure is invoked to handle dash characters ("\-" in
1.538 +# troff). It outputs a special dash character.
1.539 +#
1.540 +# Arguments:
1.541 +# None.
1.542 +
1.543 +proc dash {} {
1.544 + global state
1.545 + if {[string equal $state(textState) "NAME"]} {
1.546 + set state(textState) 0
1.547 + }
1.548 + text "-"
1.549 +}
1.550 +
1.551 +
1.552 +# tab --
1.553 +#
1.554 +# This procedure is invoked to handle tabs in the troff input.
1.555 +# Right now it does nothing.
1.556 +#
1.557 +# Arguments:
1.558 +# None.
1.559 +
1.560 +proc tab {} {
1.561 + global file
1.562 +
1.563 + textSetup
1.564 + puts -nonewline $file "\\tab "
1.565 +}
1.566 +
1.567 +
1.568 +# setTabs --
1.569 +#
1.570 +# This procedure handles the ".ta" macro, which sets tab stops.
1.571 +#
1.572 +# Arguments:
1.573 +# tabList - List of tab stops, each consisting of a number
1.574 +# followed by "i" (inch) or "c" (cm).
1.575 +
1.576 +proc setTabs {tabList} {
1.577 + global file state
1.578 +
1.579 + set state(tabs) {}
1.580 + foreach arg $tabList {
1.581 + set distance [expr {$state(leftMargin) \
1.582 + + ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}]
1.583 + lappend state(tabs) [expr {round($distance)}]
1.584 + }
1.585 +}
1.586 +
1.587 +
1.588 +
1.589 +# lineBreak --
1.590 +#
1.591 +# Generates a line break in the HTML output.
1.592 +#
1.593 +# Arguments:
1.594 +# None.
1.595 +
1.596 +proc lineBreak {} {
1.597 + global state
1.598 + textSetup
1.599 + set state(breakPending) 1
1.600 +}
1.601 +
1.602 +
1.603 +
1.604 +# newline --
1.605 +#
1.606 +# This procedure is invoked to handle newlines in the troff input.
1.607 +# It outputs either a space character or a newline character, depending
1.608 +# on fill mode.
1.609 +#
1.610 +# Arguments:
1.611 +# None.
1.612 +
1.613 +proc newline {} {
1.614 + global state
1.615 +
1.616 + if {$state(inTP)} {
1.617 + set state(inTP) 0
1.618 + lineBreak
1.619 + } elseif {$state(noFill)} {
1.620 + lineBreak
1.621 + } else {
1.622 + text " "
1.623 + }
1.624 +}
1.625 +
1.626 +
1.627 +# pageBreak --
1.628 +#
1.629 +# This procedure is invoked to generate a page break.
1.630 +#
1.631 +# Arguments:
1.632 +# None.
1.633 +
1.634 +proc pageBreak {} {
1.635 + global file curVer
1.636 + if {[string equal $curVer ""]} {
1.637 + puts $file {\page}
1.638 + } else {
1.639 + puts $file {\par}
1.640 + puts $file {\pard\sb400\qc}
1.641 + puts $file "Last change: $curVer\\page"
1.642 + }
1.643 +}
1.644 +
1.645 +
1.646 +# char --
1.647 +#
1.648 +# This procedure is called to handle a special character.
1.649 +#
1.650 +# Arguments:
1.651 +# name - Special character named in troff \x or \(xx construct.
1.652 +
1.653 +proc char {name} {
1.654 + global file state
1.655 +
1.656 + switch -exact $name {
1.657 + \\o {
1.658 + set state(intl) 1
1.659 + }
1.660 + \\\ {
1.661 + textSetup
1.662 + puts -nonewline $file " "
1.663 + }
1.664 + \\0 {
1.665 + textSetup
1.666 + puts -nonewline $file " \\emspace "
1.667 + }
1.668 + \\\\ {
1.669 + textSetup
1.670 + puts -nonewline $file "\\\\"
1.671 + }
1.672 + \\(+- {
1.673 + textSetup
1.674 + puts -nonewline $file "\\'b1 "
1.675 + }
1.676 + \\% -
1.677 + \\| {
1.678 + }
1.679 + \\(bu {
1.680 + textSetup
1.681 + puts -nonewline $file "·"
1.682 + }
1.683 + default {
1.684 + puts stderr "Unknown character: $name"
1.685 + }
1.686 + }
1.687 +}
1.688 +
1.689 +
1.690 +# macro2 --
1.691 +#
1.692 +# This procedure handles macros that are invoked with a leading "'"
1.693 +# character instead of space. Right now it just generates an
1.694 +# error diagnostic.
1.695 +#
1.696 +# Arguments:
1.697 +# name - The name of the macro (without the ".").
1.698 +# args - Any additional arguments to the macro.
1.699 +
1.700 +proc macro2 {name args} {
1.701 + puts stderr "Unknown macro: '$name [join $args " "]"
1.702 +}
1.703 +
1.704 +
1.705 +
1.706 +# SHmacro --
1.707 +#
1.708 +# Subsection head; handles the .SH macro.
1.709 +#
1.710 +# Arguments:
1.711 +# name - Section name.
1.712 +
1.713 +proc SHmacro {argList} {
1.714 + global file state
1.715 +
1.716 + set args [join $argList " "]
1.717 + if {[llength $argList] < 1} {
1.718 + puts stderr "Bad .SH macro: .SH $args"
1.719 + }
1.720 +
1.721 + # control what the text proc does with text
1.722 +
1.723 + switch $args {
1.724 + NAME {set state(textState) NAME}
1.725 + DESCRIPTION {set state(textState) INSERT}
1.726 + INTRODUCTION {set state(textState) INSERT}
1.727 + "WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT}
1.728 + "SEE ALSO" {set state(textState) SEE}
1.729 + KEYWORDS {set state(textState) KEY; return}
1.730 + }
1.731 +
1.732 + if {$state(breakPending) != -1} {
1.733 + set state(breakPending) 1
1.734 + } else {
1.735 + set state(breakPending) 0
1.736 + }
1.737 + set state(noFill) 0
1.738 + nextPara 0i
1.739 + font B
1.740 + text $args
1.741 + font R
1.742 + nextPara .5i
1.743 +}
1.744 +
1.745 +
1.746 +
1.747 +# IPmacro --
1.748 +#
1.749 +# This procedure is invoked to handle ".IP" macros, which may take any
1.750 +# of the following forms:
1.751 +#
1.752 +# .IP [1] Translate to a "1Step" state(paragraph).
1.753 +# .IP [x] (x > 1) Translate to a "Step" state(paragraph).
1.754 +# .IP Translate to a "Bullet" state(paragraph).
1.755 +# .IP text count Translate to a FirstBody state(paragraph) with special
1.756 +# indent and tab stop based on "count", and tab after
1.757 +# "text".
1.758 +#
1.759 +# Arguments:
1.760 +# argList - List of arguments to the .IP macro.
1.761 +#
1.762 +# HTML limitations: 'count' in '.IP text count' is ignored.
1.763 +
1.764 +proc IPmacro {argList} {
1.765 + global file state
1.766 +
1.767 + set length [llength $argList]
1.768 + if {$length == 0} {
1.769 + newPara 0.5i
1.770 + return
1.771 + }
1.772 + if {$length == 1} {
1.773 + newPara 0.5i -0.5i
1.774 + set state(sb) 80
1.775 + setTabs 0.5i
1.776 + formattedText [lindex $argList 0]
1.777 + tab
1.778 + return
1.779 + }
1.780 + if {$length == 2} {
1.781 + set count [lindex $argList 1]
1.782 + set tab [expr $count * 0.1]i
1.783 + newPara $tab -$tab
1.784 + set state(sb) 80
1.785 + setTabs $tab
1.786 + formattedText [lindex $argList 0]
1.787 + tab
1.788 + return
1.789 + }
1.790 + puts stderr "Bad .IP macro: .IP [join $argList " "]"
1.791 +}
1.792 +
1.793 +
1.794 +# TPmacro --
1.795 +#
1.796 +# This procedure is invoked to handle ".TP" macros, which may take any
1.797 +# of the following forms:
1.798 +#
1.799 +# .TP x Translate to an state(indent)ed state(paragraph) with the
1.800 +# specified state(indent) (in 100 twip units).
1.801 +# .TP Translate to an state(indent)ed state(paragraph) with
1.802 +# default state(indent).
1.803 +#
1.804 +# Arguments:
1.805 +# argList - List of arguments to the .IP macro.
1.806 +#
1.807 +# HTML limitations: 'x' in '.TP x' is ignored.
1.808 +
1.809 +proc TPmacro {argList} {
1.810 + global state
1.811 + set length [llength $argList]
1.812 + if {$length == 0} {
1.813 + set val 0.5i
1.814 + } else {
1.815 + set val [expr {([lindex $argList 0] * 100.0)/1440}]i
1.816 + }
1.817 + newPara $val -$val
1.818 + setTabs $val
1.819 + set state(inTP) 1
1.820 + set state(sb) 120
1.821 +}
1.822 +
1.823 +
1.824 +# THmacro --
1.825 +#
1.826 +# This procedure handles the .TH macro. It generates the non-scrolling
1.827 +# header section for a given man page, and enters information into the
1.828 +# table of contents. The .TH macro has the following form:
1.829 +#
1.830 +# .TH name section date footer header
1.831 +#
1.832 +# Arguments:
1.833 +# argList - List of arguments to the .TH macro.
1.834 +
1.835 +proc THmacro {argList} {
1.836 + global file curPkg curSect curID id_keywords state curVer bitmap
1.837 +
1.838 + if {[llength $argList] != 5} {
1.839 + set args [join $argList " "]
1.840 + puts stderr "Bad .TH macro: .TH $args"
1.841 + }
1.842 + incr curID
1.843 + set name [lindex $argList 0] ;# Tcl_UpVar
1.844 + set page [lindex $argList 1] ;# 3
1.845 + set curVer [lindex $argList 2] ;# 7.4
1.846 + set curPkg [lindex $argList 3] ;# Tcl
1.847 + set curSect [lindex $argList 4] ;# {Tcl Library Procedures}
1.848 +
1.849 + regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl]
1.850 +
1.851 + puts $file "#{\\footnote $curID}" ;# Context string
1.852 + puts $file "\${\\footnote $name}" ;# Topic title
1.853 + set browse "${curSect}${name}"
1.854 + regsub -all {[ _-]} $browse {} browse
1.855 + puts $file "+{\\footnote $browse}" ;# Browse sequence
1.856 +
1.857 + # Suppress duplicates
1.858 + foreach i $id_keywords($curID) {
1.859 + set keys($i) 1
1.860 + }
1.861 + foreach i [array names keys] {
1.862 + set i [string trim $i]
1.863 + if {[string length $i] > 0} {
1.864 + puts $file "K{\\footnote $i}" ;# Keyword strings
1.865 + }
1.866 + }
1.867 + unset keys
1.868 + puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn"
1.869 + font B
1.870 + text $name
1.871 + tab
1.872 + text $curSect
1.873 + font R
1.874 + if {[info exists bitmap]} {
1.875 + # a right justified bitmap
1.876 + puts $file "\\\{bmrt $bitmap\\\}"
1.877 + }
1.878 + puts $file "\\fs20"
1.879 + set state(breakPending) -1
1.880 +}
1.881 +
1.882 +# nextPara --
1.883 +#
1.884 +# Set the indents for a new paragraph, and start a paragraph break
1.885 +#
1.886 +# Arguments:
1.887 +# leftIndent - The new left margin for body lines.
1.888 +# firstIndent - The offset from the left margin for the first line.
1.889 +
1.890 +proc nextPara {leftIndent {firstIndent 0i}} {
1.891 + global state
1.892 + set state(leftIndent) [getTwips $leftIndent]
1.893 + set state(firstIndent) [getTwips $firstIndent]
1.894 + set state(paragraphPending) 1
1.895 +}
1.896 +
1.897 +
1.898 +# newPara --
1.899 +#
1.900 +# This procedure sets the left and hanging state(indent)s for a line.
1.901 +# State(Indent)s are specified in units of inches or centimeters, and are
1.902 +# relative to the current nesting level and left margin.
1.903 +#
1.904 +# Arguments:
1.905 +# leftState(Indent) - The new left margin for lines after the first.
1.906 +# firstState(Indent) - The new left margin for the first line of a state(paragraph).
1.907 +
1.908 +proc newPara {leftIndent {firstIndent 0i}} {
1.909 + global state file
1.910 + if $state(paragraph) {
1.911 + puts -nonewline $file "\\line\n"
1.912 + }
1.913 + if {$leftIndent != ""} {
1.914 + set state(leftIndent) [expr {$state(leftMargin) \
1.915 + + ($state(offset) * $state(nestingLevel)) \
1.916 + + [getTwips $leftIndent]}]
1.917 + }
1.918 + set state(firstIndent) [getTwips $firstIndent]
1.919 + set state(paragraphPending) 1
1.920 +}
1.921 +
1.922 +
1.923 +# getTwips --
1.924 +#
1.925 +# This procedure converts a distance in inches or centimeters into
1.926 +# twips (1/1440 of an inch).
1.927 +#
1.928 +# Arguments:
1.929 +# arg - A number followed by "i" or "c"
1.930 +
1.931 +proc getTwips {arg} {
1.932 + if {[scan $arg "%f%s" distance units] != 2} {
1.933 + puts stderr "bad distance \"$arg\""
1.934 + return 0
1.935 + }
1.936 + switch -- $units {
1.937 + c {
1.938 + set distance [expr {$distance * 567}]
1.939 + }
1.940 + i {
1.941 + set distance [expr {$distance * 1440}]
1.942 + }
1.943 + default {
1.944 + puts stderr "bad units in distance \"$arg\""
1.945 + continue
1.946 + }
1.947 + }
1.948 + return $distance
1.949 +}
1.950 +
1.951 +# incrNestingLevel --
1.952 +#
1.953 +# This procedure does the work of the .RS macro, which increments
1.954 +# the number of state(indent)ations that affect things like .PP.
1.955 +#
1.956 +# Arguments:
1.957 +# None.
1.958 +
1.959 +proc incrNestingLevel {} {
1.960 + global state
1.961 +
1.962 + incr state(nestingLevel)
1.963 + set oldp $state(paragraph)
1.964 + set state(paragraph) 0
1.965 + newPara 0i
1.966 + set state(paragraph) $oldp
1.967 +}
1.968 +
1.969 +# decrNestingLevel --
1.970 +#
1.971 +# This procedure does the work of the .RE macro, which decrements
1.972 +# the number of indentations that affect things like .PP.
1.973 +#
1.974 +# Arguments:
1.975 +# None.
1.976 +
1.977 +proc decrNestingLevel {} {
1.978 + global state
1.979 +
1.980 + if {$state(nestingLevel) == 0} {
1.981 + puts stderr "Nesting level decremented below 0"
1.982 + } else {
1.983 + incr state(nestingLevel) -1
1.984 + }
1.985 +}
1.986 +