home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / man2ipf2.tcl < prev    next >
Text File  |  2001-09-05  |  22KB  |  950 lines
  1. # man2ipf2.tcl --
  2. #
  3. # This file defines procedures that are used during the second pass of the
  4. # man page to IPF conversion process. It is sourced by man2ipf.tcl.
  5. #
  6. # Copyright (c) 1996 by Sun Microsystems, Inc.
  7. # Copyright (c) 1999 by Illya Vaes
  8. #
  9. # SCCS: @(#) man2ipf2.tcl 1.2 96/03/21 10:48:30
  10. #
  11.  
  12. # Global variables used by these scripts:
  13. #
  14. # NAME_file -    array indexed by NAME and containing file names used
  15. #        for hyperlinks.
  16. #
  17. # textState -    state variable defining action of 'text' proc.
  18. #
  19. # nestStk -    stack oriented list containing currently active
  20. #        HTML tags (UL, OL, DL). Local to 'nest' proc.
  21. #
  22. # inDT -    set by 'TPmacro', cleared by 'newline'. Used to insert
  23. #        the <DT> tag while in a dictionary list <DL>.
  24. #
  25. # curFont -    Name of special font that is currently in
  26. #        use.  Null means the default paragraph font
  27. #        is being used.
  28. #
  29. # file -    Where to output the generated HTML.
  30. #
  31. # fontStart -    Array to map font names to starting sequences.
  32. #
  33. # fontEnd -    Array to map font names to ending sequences.
  34. #
  35. # noFillCount -    Non-zero means don't fill the next $noFillCount
  36. #        lines: force a line break at each newline.  Zero
  37. #        means filling is enabled, so don't output line
  38. #        breaks for each newline.
  39. #
  40. # footer -    info inserted at bottom of each page. Normally read
  41. #        from the xref.tcl file
  42.     
  43. # initGlobals --
  44. #
  45. # This procedure is invoked to set the initial values of all of the
  46. # global variables, before processing a man page.
  47. #
  48. # Arguments:
  49. # None.
  50.  
  51. proc initGlobals {} {
  52.     global file noFillCount textState
  53.     global fontStart fontEnd curFont inPRE charCnt dummyHeader
  54.  
  55.     nest init
  56.     set dummyHeader 0
  57.     set inPRE 0
  58.     set textState 0
  59.     set curFont ""
  60.     set fontStart(Code) ":hp2."
  61.     set fontStart(Emphasis) ":hp1."
  62.     set fontEnd(Code) ":ehp2."
  63.     set fontEnd(Emphasis) ":ehp1."
  64.     set noFillCount 0
  65.     set charCnt 0
  66.     setTabs 0.5i
  67. }
  68.  
  69.  
  70. # beginFont --
  71. #
  72. # Arranges for future text to use a special font, rather than
  73. # the default paragraph font.
  74. #
  75. # Arguments:
  76. # font -        Name of new font to use.
  77.  
  78. proc beginFont font {
  79.     global curFont file fontStart
  80.  
  81. # Tclsh 8.3.3: if {[string equal $curFont $font]} { #}
  82.     if {$curFont == $font} {
  83.     return
  84.     }
  85.     endFont
  86.     puts -nonewline $file $fontStart($font)
  87.     set curFont $font
  88. }
  89.  
  90.  
  91. # endFont --
  92. #
  93. # Reverts to the default font for the paragraph type.
  94. #
  95. # Arguments:
  96. # None.
  97.  
  98. proc endFont {} {
  99.     global curFont file fontEnd
  100.  
  101. # Tcl 8.3.3:  if {[string compare $curFont ""]} { #}
  102.     if {$curFont != ""} {
  103.     puts -nonewline $file $fontEnd($curFont)
  104.     set curFont ""
  105.     }
  106. }
  107.  
  108.  
  109.  
  110. # text --
  111. #
  112. # This procedure adds text to the current paragraph.  If this is
  113. # the first text in the paragraph then header information for the
  114. # paragraph is output before the text.
  115. # Keep length of lines below 255.
  116. #
  117. # Arguments:
  118. # string -        Text to output in the paragraph.
  119.  
  120. proc text string {
  121.     global file textState inDT charCnt beforeSynopsis
  122.  
  123.     set pos [string first "\t" $string]
  124.     if {$pos >= 0} {
  125.         text [string range $string 0 [expr $pos-1]]
  126.         tab
  127.         text [string range $string [expr $pos+1] end]
  128.     return        
  129.     }
  130.     incr charCnt [string length $string]
  131. # Tcl 8.3.3:
  132. #set string [string map [list \
  133. #      "\\"        "\\\\" \
  134. #      "\{"        "\\\{" \
  135. #      "\}"        "\\\}" \
  136. #      "\t"        {\tab } \
  137. #      ''          "\\rdblquote " \
  138. #      ``          "\\ldblquote " \
  139. #      ] $string]
  140.     regsub -all {&} $string {\&.}  string
  141.     regsub -all {\.\.\.} $string {\&period.\&period.\&period.}  string
  142.     regsub -all {<} $string {\<.}  string
  143.     regsub -all {>} $string {\>.}  string
  144.     regsub -all {``} $string {\&odq.}  string
  145.     regsub -all {''} $string {\&cdq.}  string
  146.     regsub -all {"} $string {\&cdq.}  string
  147.     regsub -all {:} $string {\&colon.}  string
  148.     switch $textState {
  149.         NAME {
  150.             # Only put in index if the is the "NAME" section before SYNOPSIS
  151.             if {$beforeSynopsis} {
  152.                 foreach i [split $string ","] {
  153. #                    lappend NAME_file([string trim $i]) $curFile
  154.                      puts $file ":i1.[string trim $i]"
  155.                 }
  156.             }
  157.         }
  158.     REF { 
  159.         if {$inDT == {}} {
  160.         set string [insertRef $string]
  161.         }
  162.     }
  163.     SEE { 
  164.         global NAME_file
  165.         foreach i [split $string] {
  166.         if {![regexp -nocase {^[a-z_]+} [string trim $i] i ]} {
  167. #             puts "Warning: $i in SEE ALSO not found"
  168.             continue
  169.         }
  170.         if {![catch {set ref $NAME_file($i)} ]} {
  171.             regsub $i $string ":link reftype=hd refid=$ref.$i:elink." string
  172.         }
  173.         }
  174.     }
  175.     }
  176.     # Don't puts more than 255 characters, since IPFC can't handle that
  177.     # but break on a space
  178.     # string length on the list of functions in the manpage of CrtChannel.3
  179.     # returns 248 while it is > 255, so use 176.
  180.     while {[string length $string] > 176} {
  181.         set indexSpace [ string last { } [string range $string 0 175] ]
  182.         puts $file [ string range $string 0 [ expr $indexSpace - 1]]
  183.         set string [ string range $string $indexSpace end]
  184.     }
  185.     puts -nonewline $file "$string"
  186. }
  187.  
  188.  
  189.  
  190. # insertRef --
  191. #
  192. #
  193. # Arguments:
  194. # string -        Text to output in the paragraph.
  195.  
  196. proc insertRef string {
  197.     global NAME_file self
  198.     set path {}
  199.     if ![catch {set ref $NAME_file([string trim $string])} ] {
  200.     if {"$ref" != $self} {
  201.         set string ":link reftype=hd ref='$ref'.$string:elink."
  202. #        puts "insertRef: $self $ref.html ---$string--"
  203.     }
  204.     }
  205.     return $string
  206. }
  207.  
  208.  
  209.  
  210. # macro --
  211. #
  212. # This procedure is invoked to process macro invocations that start
  213. # with "." (instead of ').
  214. #
  215. # Arguments:
  216. # name -        The name of the macro (without the ".").
  217. # args -        Any additional arguments to the macro.
  218.  
  219. proc macro {name args} {
  220.     switch $name {
  221.     AP {
  222.             if {[llength $args] != 3 && [llength $args] != 2} {
  223.                 puts stderr "Bad .AP macro: .$name [join $args " "]"
  224.             }
  225.         setTabs {1.25i 2.5i 3.75i}
  226.         TPmacro {}
  227.         font B
  228.         text "[lindex $args 0]  "
  229.         font I
  230.         text "[lindex $args 1]"
  231.         font R
  232.             if {[llength $args] == 3} {
  233.                 text "([lindex $args 2])"
  234.             }
  235.         newline
  236.     }
  237.     AS {}                ;# next page and previous page
  238.     br {
  239.         lineBreak    
  240.     }
  241.         B  {
  242.         font B
  243.         formattedText "$args"
  244.             font R
  245.         }
  246.     BS {}
  247.     BE {}
  248.     CE {
  249.         global file noFillCount inPRE
  250.         puts $file ":ecgraphic."
  251.             #puts $file {:font facename=default.}
  252.         set inPRE 0
  253.     }
  254.     CS {                ;# code section
  255.         global file noFillCount inPRE dummyHeader
  256.             #puts $file {:font facename=Courier.}
  257.         puts -nonewline $file ":h3 res=${dummyHeader}.:cgraphic."
  258.         set inPRE 1
  259.             incr dummyHeader
  260.     }
  261.     DE {
  262.         global file noFillCount inPRE
  263.         puts $file ":ecgraphic."
  264.         set inPRE 0
  265.         set noFillCount 0
  266.     }
  267.     DS {
  268.         global file noFillCount inPRE
  269.         puts -nonewline $file ":cgraphic."
  270.         set noFillCount 10000000
  271.         set inPRE 1
  272.     }
  273.     fi {
  274.         global noFillCount
  275.         set noFillCount 0
  276.     }
  277.         I  {
  278.         font I
  279.         formattedText "$args"
  280.             font R
  281.         }
  282.     IP {
  283.         IPmacro $args
  284.     }
  285.     LP {
  286.         nest decr
  287.         nest incr
  288.         newPara
  289.     }
  290.     ne {
  291.     }
  292.     nf {
  293.         global noFillCount
  294.         set noFillCount 1000000
  295.     }
  296.     OP {
  297.         global inDT file inPRE 
  298.         if {[llength $args] != 3} {
  299.         puts stderr "Bad .OP macro: .$name [join $args " "]"
  300.         }
  301.         nest para dl dt
  302.         set inPRE 1
  303.         puts -nonewline $file ":cgraphic."
  304.         setTabs 4c
  305.         text "Command-Line Name:"
  306.         tab
  307.         font B
  308.         set x [lindex $args 0]
  309.         regsub -all {\\-} $x - x
  310.         text $x
  311.         newline
  312.         font R
  313.         text "Database Name:"
  314.         tab
  315.         font B
  316.         text [lindex $args 1]
  317.         newline
  318.         font R
  319.         text "Database Class:"
  320.         tab
  321.         font B
  322.         text [lindex $args 2]
  323.         font R
  324.         puts -nonewline $file ":ecgraphic.\n.br"
  325.         set inDT "\n:dd."            ;# next newline writes inDT 
  326.         set inPRE 0
  327.         newline
  328.     }
  329.         P {
  330.             newPara
  331.         }
  332.     PP {
  333.         nest decr
  334.         nest incr
  335.         newPara
  336.     }
  337.     RE {
  338.             global file
  339.         nest decr    
  340.             puts $file {:font facename=SystemMonospaced.}
  341.     }
  342.     RS {
  343.             global file
  344.             puts $file {:font facename=Courier.}
  345.         nest incr
  346.     }
  347.     SE {
  348.         global noFillCount textState inPRE file
  349.  
  350.         font R
  351.         puts -nonewline $file ":ecgraphic."
  352.         set inPRE 0
  353.         set noFillCount 0
  354.         nest reset
  355.         newPara
  356.         text "See the "
  357.         font B
  358.         set temp $textState
  359.         set textState REF
  360.         text options
  361.         set textState $temp
  362.         font R
  363.         text " manual entry for detailed descriptions of the above options."
  364.     }
  365.     SH {
  366.         SHmacro $args
  367.     }
  368.     SO {
  369.         global noFillCount inPRE file
  370.  
  371.         SHmacro "STANDARD OPTIONS"
  372.         setTabs {4c 8c 12c}
  373.         set noFillCount 1000000
  374.         puts -nonewline $file ":cgraphic."
  375.         set inPRE 1
  376.         font B
  377.     }
  378.     so {
  379.         if {$args != "man.macros"} {
  380.         puts stderr "Unknown macro: .$name [join $args " "]"
  381.         }
  382.     }
  383.     sp {                    ;# needs work
  384.         if {$args == ""} {
  385.         set count 1
  386.         } else {
  387.         set count [lindex $args 0]
  388.         }
  389.         while {$count > 0} {
  390.         lineBreak
  391.         incr count -1
  392.         }
  393.     }
  394.     ta {
  395.         setTabs $args
  396.     }
  397.     TH {
  398.         THmacro $args
  399.     }
  400.     TP {
  401.         TPmacro $args
  402.     }
  403.     UL {                    ;# underline
  404.         global file
  405.         puts -nonewline $file ":hp7."    ;# Bold and underlined
  406.         text [lindex $args 0]
  407.         puts -nonewline $file ":ehp7."
  408.         if {[llength $args] == 2} {
  409.         text [lindex $args 1]
  410.         }
  411.     }
  412.     VE {
  413. #        global file
  414. #        puts -nonewline $file "</FONT>"
  415.     }
  416.     VS {
  417. #        global file
  418. #        if {[llength $args] > 0} {
  419. #        puts -nonewline $file "<BR>"
  420. #        }
  421. #        puts -nonewline $file "<FONT COLOR=\"GREEN\">"
  422.     }
  423.     default {
  424.         puts stderr "Unknown macro: .$name [join $args " "]"
  425.     }
  426.     }
  427.  
  428. #    global nestStk; puts "$name [format "%-20s" $args] $nestStk"
  429. #    flush stdout; flush stderr
  430. }
  431.  
  432.  
  433. # font --
  434. #
  435. # This procedure is invoked to handle font changes in the text
  436. # being output.
  437. #
  438. # Arguments:
  439. # type -        Type of font: R, I, B, or S.
  440.  
  441. proc font type {
  442.     global textState
  443.     switch $type {
  444.     P -
  445.     R {
  446.         endFont
  447.         if {$textState == "REF"} {
  448.         set textState INSERT
  449.         }
  450.     }
  451.     B {
  452.         beginFont Code
  453.         if {$textState == "INSERT"} {
  454.         set textState REF
  455.         }
  456.     }
  457.     I {
  458.         beginFont Emphasis
  459.     }
  460.     S {
  461.     }
  462.     default {
  463.         puts stderr "Unknown font: $type"
  464.     }
  465.     }
  466. }
  467.  
  468.  
  469.  
  470. # formattedText --
  471. #
  472. # Insert a text string that may also have \fB-style font changes
  473. # and a few other backslash sequences in it.
  474. #
  475. # Arguments:
  476. # text -        Text to insert.
  477.  
  478. proc formattedText text {
  479. #    puts "formattedText: $text"
  480.     while {$text != ""} {
  481.     set index [string first \\ $text]
  482.     if {$index < 0} {
  483.         text $text
  484.         return
  485.     }
  486.     text [string range $text 0 [expr $index-1]]
  487.     set c [string index $text [expr $index+1]]
  488.     switch -- $c {
  489.         f {
  490.         font [string index $text [expr $index+2]]
  491.         set text [string range $text [expr $index+3] end]
  492.         }
  493.         e {
  494.         text \\
  495.         set text [string range $text [expr $index+2] end]
  496.         }
  497.         - {
  498.         dash
  499.         set text [string range $text [expr $index+2] end]
  500.         }
  501.         | {
  502.         set text [string range $text [expr $index+2] end]
  503.         }
  504.         default {
  505.         puts stderr "Unknown sequence: \\$c"
  506.         set text [string range $text [expr $index+2] end]
  507.         }
  508.     }
  509.     }
  510. }
  511.  
  512.  
  513.  
  514. # dash --
  515. #
  516. # This procedure is invoked to handle dash characters ("\-" in
  517. # troff).  It outputs a special dash character.
  518. #
  519. # Arguments:
  520. # None.
  521.  
  522. proc dash {} {
  523.     global textState charCnt
  524.     if {$textState == "NAME"} {
  525.         set textState 0
  526.     }
  527.     incr charCnt
  528.     text "-"
  529. }
  530.  
  531.  
  532. # tab --
  533. #
  534. # This procedure is invoked to handle tabs in the troff input.
  535. # Right now it does nothing.
  536. #
  537. # Arguments:
  538. # None.
  539.  
  540. proc tab {} {
  541.     global inPRE charCnt tabString
  542. #    ? charCnt
  543.     if {$inPRE == 1} {
  544.     set pos [expr $charCnt % [string length $tabString] ]
  545.     set spaces [string first "1" [string range $tabString $pos end] ]
  546.     text [format "%*s" [incr spaces] " "]
  547.     } else {
  548. #    puts "tab: found tab outside of <PRE> block"
  549.     }
  550. }
  551.  
  552.  
  553. # setTabs --
  554. #
  555. # This procedure handles the ".ta" macro, which sets tab stops.
  556. #
  557. # Arguments:
  558. # tabList -    List of tab stops, each consisting of a number
  559. #            followed by "i" (inch) or "c" (cm).
  560.  
  561. proc setTabs {tabList} {
  562.     global file breakPending tabString
  563.  
  564. #    puts "setTabs: --$tabList--"
  565.     set last 0
  566.     set tabString {}
  567.     set charsPerInch 14.
  568.     set numTabs [llength $tabList]
  569.     foreach arg $tabList {
  570.     if {[scan $arg "%f%s" distance units] != 2} {
  571.         puts stderr "bad distance \"$arg\""
  572.         return 0
  573.         }
  574.     switch -- $units {
  575.         c    {
  576.         set distance [expr $distance * $charsPerInch / 2.54 ]
  577.         }
  578.         i    {
  579.         set distance [expr $distance * $charsPerInch]
  580.         }
  581.         default {
  582.         puts stderr "bad units in distance \"$arg\""
  583.         continue
  584.         }
  585.         }
  586. #        ? distance
  587.         lappend tabString [format "%*s1" [expr round($distance-$last-1)] " "]
  588.         set last $distance
  589.     }
  590.     set tabString [join $tabString {}]
  591. #    puts "setTabs: --$tabString--"
  592. }
  593.  
  594.  
  595.  
  596. # lineBreak --
  597. #
  598. # Generates a line break in the HTML output.
  599. #
  600. # Arguments:
  601. # None.
  602.  
  603. proc lineBreak {} {
  604.     global file inPRE
  605.  
  606.     if {$inPRE} {
  607.         puts $file "\n"
  608.     } else {
  609.         puts $file "\n.br\n"
  610.     }
  611. }
  612.  
  613.  
  614.  
  615. # newline --
  616. #
  617. # This procedure is invoked to handle newlines in the troff input.
  618. # It outputs either a space character or a newline character, depending
  619. # on fill mode.
  620. #
  621. # Arguments:
  622. # None.
  623.  
  624. proc newline {} {
  625.     global noFillCount file inDT inPRE charCnt
  626.  
  627.     if {$inDT != {} } {
  628.         puts $file "\n$inDT"
  629.         set inDT {}
  630.     } elseif {$noFillCount == 0 || $inPRE == 1} {
  631.     puts $file {}
  632.     } else {
  633.     lineBreak
  634.     incr noFillCount -1
  635.     }
  636.     set charCnt 0
  637. }
  638.  
  639.  
  640.  
  641. # char --
  642. #
  643. # This procedure is called to handle a special character.
  644. #
  645. # Arguments:
  646. # name -        Special character named in troff \x or \(xx construct.
  647.  
  648. proc char name {
  649.     global file charCnt
  650.  
  651.     incr charCnt
  652. #    puts "char: $name"
  653.     # In comments explanations from NROFF/TROFF User's Manual (Oct.11, 1976)
  654.     switch -exact $name {
  655.     \\0 { ; # Digit width space
  656.         puts -nonewline $file " "
  657.     }
  658.     \\\\ { ; # Escaped backslash
  659.         puts -nonewline $file "\\"
  660.     }
  661.     \\(+- { ; # Character named +- (plusminus)
  662.         puts -nonewline $file "&plusmin."
  663.     }
  664.     \\% - ; # Default optionale hyphenation character
  665.     \\| { ; # 1/6 em narrow space character (zero width in NROFF)
  666.     }
  667.     default {
  668.         puts stderr "Unknown character: $name"
  669.     }
  670.     }
  671. }
  672.  
  673.  
  674. # macro2 --
  675. #
  676. # This procedure handles macros that are invoked with a leading "'"
  677. # character instead of space.  Right now it just generates an
  678. # error diagnostic.
  679. #
  680. # Arguments:
  681. # name -        The name of the macro (without the ".").
  682. # args -        Any additional arguments to the macro.
  683.  
  684. proc macro2 {name args} {
  685.     puts stderr "Unknown macro: '$name [join $args " "]"
  686. }
  687.  
  688.  
  689.  
  690. # SHmacro --
  691. #
  692. # Subsection head; handles the .SH macro.
  693. #
  694. # Arguments:
  695. # name -        Section name.
  696.  
  697. proc SHmacro argList {
  698.     global file noFillCount textState charCnt beforeSynopsis
  699.  
  700.     set args [join $argList " "]
  701.     if {[llength $argList] < 1} {
  702.     puts stderr "Bad .SH macro: .$name $args"
  703.     }
  704.  
  705.     set noFillCount 0
  706.     nest reset
  707.  
  708.     if {$args != {NAME} || !$beforeSynopsis} {
  709.         puts -nonewline $file ":p."
  710.     }
  711.     puts -nonewline $file ":hp4."
  712.     text  $args
  713.     puts $file ":ehp4.\n:p."
  714.  
  715. #    ? args textState
  716.  
  717.     # control what the text proc does with text
  718.     
  719.     switch $args {
  720.     NAME {set textState NAME}
  721.     DESCRIPTION {set textState INSERT}
  722.     INTRODUCTION {set textState INSERT}
  723.     "WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
  724.     "SEE ALSO" {set textState SEE}
  725.     KEYWORDS {set textState 0}
  726.         SYNOPSIS {set beforeSynopsis 0}
  727.     }
  728.     set charCnt 0
  729. }
  730.  
  731.  
  732.  
  733. # IPmacro --
  734. #
  735. # This procedure is invoked to handle ".IP" macros, which may take any
  736. # of the following forms:
  737. #
  738. # .IP [1]            Translate to a "1Step" paragraph.
  739. # .IP [x] (x > 1)    Translate to a "Step" paragraph.
  740. # .IP                Translate to a "Bullet" paragraph.
  741. # .IP text count    Translate to a FirstBody paragraph with special
  742. #                    indent and tab stop based on "count", and tab after
  743. #                    "text".
  744. #
  745. # Arguments:
  746. # argList -        List of arguments to the .IP macro.
  747. #
  748. # HTML limitations: 'count' in '.IP text count' is ignored.
  749.  
  750. proc IPmacro argList {
  751.     global file
  752.  
  753.     setTabs 0.5i
  754.     set length [llength $argList]
  755.     if {$length == 0} {
  756.         nest para UL LI
  757.     return
  758.     }
  759.     if {$length == 1} {
  760.         nest para OL LI
  761.         return
  762.     }
  763.     if {$length > 1} {
  764.         nest para dl dt
  765.         formattedText [lindex $argList 0]
  766.         puts $file "\n:dd."
  767.         return
  768.     }
  769.     puts stderr "Bad .IP macro: .IP [join $argList " "]"
  770. }
  771.  
  772.  
  773. # TPmacro --
  774. #
  775. # This procedure is invoked to handle ".TP" macros, which may take any
  776. # of the following forms:
  777. #
  778. # .TP x        Translate to an indented paragraph with the
  779. #             specified indent (in 100 twip units).
  780. # .TP        Translate to an indented paragraph with
  781. #             default indent.
  782. #
  783. # Arguments:
  784. # argList -        List of arguments to the .IP macro.
  785. #
  786. # HTML limitations: 'x' in '.TP x' is ignored.
  787.  
  788.  
  789. proc TPmacro {argList} {
  790.     global inDT file
  791.     nest para dl dt
  792.     set inDT "\n:dd."            ;# next newline writes inDT 
  793.     setTabs 0.5i
  794. }
  795.  
  796.  
  797.  
  798. # THmacro --
  799. #
  800. # This procedure handles the .TH macro.  It generates the non-scrolling
  801. # header section for a given man page, and enters information into the
  802. # table of contents.  The .TH macro has the following form:
  803. #
  804. # .TH name section date footer header
  805. #
  806. # Arguments:
  807. # argList -        List of arguments to the .TH macro.
  808.  
  809. proc THmacro {argList} {
  810.     global file nextres res beforeSynopsis
  811.  
  812.     if {[llength $argList] != 5} {
  813.     set args [join $argList " "]
  814.     puts stderr "Bad .TH macro: .TH $args"
  815.     }
  816.     set name  [lindex $argList 0]        ;# Tcl_UpVar
  817.     set page  [lindex $argList 1]        ;# 3
  818.     set vers  [lindex $argList 2]        ;# 7.4
  819.     set lib   [lindex $argList 3]        ;# Tcl
  820.     set pname [lindex $argList 4]        ;# {Tcl Library Procedures}
  821.     set beforeSynopsis 1
  822. #puts "name \[$name\] page \[$page\] vers \[$vers\] lib \[$lib\] pname \[$pname\]"
  823.     
  824.     # This is what gets put in the contents of the INF-file
  825. #    set res($name) $nextres
  826. #    puts -nonewline $file "\n:h1 res=$nextres."
  827.     puts -nonewline $file "\n:h2 name='$name'."
  828. #    set nextres [ expr $nextres + 1 ]
  829.     text $name
  830.     puts $file "\n"
  831.  
  832. #    if {$vers != {}} {
  833. #        puts $file ":i1.$name ($page) - $lib v$vers"
  834. #    } else {
  835. #        puts $file ":i1.$name ($page) - $lib"
  836. #    }
  837. #    puts $file ":link reftype=hd refid=$res($name).:elink."
  838. #    puts $file ":link reftype=hd refid='$pname'.:elink."
  839. }
  840.  
  841.  
  842.  
  843. # newPara --
  844. #
  845. # This procedure sets the left and hanging indents for a line.
  846. # Indents are specified in units of inches or centimeters, and are
  847. # relative to the current nesting level and left margin.
  848. #
  849. # Arguments:
  850. # None
  851.  
  852. proc newPara {} {
  853.     global file nestStk
  854.     
  855.     if {[lindex $nestStk end] != "NEW" } {
  856.     nest decr    
  857.     }
  858.     puts -nonewline $file ":p."
  859. }
  860.  
  861.  
  862.  
  863. # nest --
  864. #
  865. # This procedure takes care of inserting the tags associated with the
  866. # IP, TP, RS, RE, LP and PP macros. Only 'nest para' takes arguments.
  867. #
  868. # Arguments:
  869. # op -                operation: para, incr, decr, reset, init
  870. # listStart -        begin list tag: OL, UL, DL.
  871. # listItem -        item tag:       LI, LI, DT.
  872.  
  873. proc nest {op {listStart "NEW"} {listItem {} } } {
  874.     global file nestStk inDT charCnt
  875. #    puts "nest: $op $listStart $listItem"
  876.     switch $op {
  877.     para {
  878.         set top [lindex $nestStk end]
  879.         if {$top == "NEW" } {
  880.         set nestStk [lreplace $nestStk end end $listStart]
  881.         puts $file ":$listStart."
  882.         } elseif {$top != $listStart} {
  883.         puts stderr "nest para: bad stack"
  884.         exit 1
  885.         }
  886.         puts $file ":$listItem."
  887.         set charCnt 0
  888.     }
  889.     incr {
  890.        lappend nestStk NEW
  891.     }
  892.     decr {
  893.         if {[llength $nestStk] == 0} {
  894.         puts stderr "nest error: nest length is zero"
  895.         set nestStk NEW
  896.         }
  897.         set tag [lindex $nestStk end]
  898.         if {$tag != "NEW"} {
  899.         puts $file ":e$tag."
  900.         }
  901.         set nestStk [lreplace $nestStk end end]
  902.     }
  903.     reset {
  904.         while {[llength $nestStk] > 0} {
  905.         nest decr
  906.         }
  907.         set nestStk NEW
  908.     }
  909.     init {
  910.         set nestStk NEW
  911.         set inDT {}
  912.     }
  913.     }
  914.     set charCnt 0
  915. }
  916.  
  917.  
  918.  
  919. # do --
  920. #
  921. # This is the toplevel procedure that translates a man page
  922. # to IPF.  It runs the man2tcl program to turn the man page
  923. # into a script, then it evals that script.
  924. #
  925. # Arguments:
  926. # fileName -        Name of the file to translate.
  927.  
  928. proc do fileName {
  929.     global file self html_dir package footer
  930.     set self "[file tail $fileName]"
  931. #    set file [open "$html_dir/$package/$self" w]
  932. #    puts "  Pass 2 -- $fileName"
  933.     flush stdout
  934.     initGlobals
  935.     if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
  936.     global errorInfo
  937.     puts stderr $msg
  938.     puts "in"
  939.     puts stderr $errorInfo
  940.     exit 1
  941.     }
  942.     nest reset
  943. #    puts $file $footer
  944. #    puts $file "</BODY></HTML>"
  945. #    close $file
  946. }
  947.  
  948.  
  949.  
  950.