summaryrefslogtreecommitdiffstats
path: root/tools/man2html2.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/man2html2.tcl')
-rw-r--r--tools/man2html2.tcl465
1 files changed, 263 insertions, 202 deletions
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl
index aee1da3..163196e 100644
--- a/tools/man2html2.tcl
+++ b/tools/man2html2.tcl
@@ -1,26 +1,28 @@
+##############################################################################
# man2html2.tcl --
#
-# This file defines procedures that are used during the second pass of the
-# man page to html conversion process. It is sourced by man2html.tcl.
+# This file defines procedures that are used during the second pass of the man
+# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
+package require Tcl 8.4
+
# Global variables used by these scripts:
#
-# NAME_file - array indexed by NAME and containing file names used
-# for hyperlinks.
+# NAME_file - array indexed by NAME and containing file names used for
+# hyperlinks.
#
# textState - state variable defining action of 'text' proc.
#
-# nestStk - stack oriented list containing currently active
-# HTML tags (UL, OL, DL). Local to 'nest' proc.
+# nestStk - stack oriented list containing currently active HTML tags (UL,
+# OL, DL). Local to 'nest' proc.
#
-# inDT - set by 'TPmacro', cleared by 'newline'. Used to insert
-# the <DT> tag while in a dictionary list <DL>.
+# inDT - set by 'TPmacro', cleared by 'newline'. Used to insert the
+# tag while in a dictionary list <DL>.
#
-# curFont - Name of special font that is currently in
-# use. Null means the default paragraph font
-# is being used.
+# curFont - Name of special font that is currently in use. Null means the
+# default paragraph font is being used.
#
# file - Where to output the generated HTML.
#
@@ -28,28 +30,29 @@
#
# fontEnd - Array to map font names to ending sequences.
#
-# noFillCount - Non-zero means don't fill the next $noFillCount
-# lines: force a line break at each newline. Zero
-# means filling is enabled, so don't output line
-# breaks for each newline.
+# noFillCount - Non-zero means don't fill the next $noFillCount lines: force a
+# line break at each newline. Zero means filling is enabled, so
+# don't output line breaks for each newline.
#
-# footer - info inserted at bottom of each page. Normally read
-# from the xref.tcl file
-
+# footer - info inserted at bottom of each page. Normally read from the
+# xref.tcl file
+
+##############################################################################
# initGlobals --
#
-# This procedure is invoked to set the initial values of all of the
-# global variables, before processing a man page.
+# This procedure is invoked to set the initial values of all of the global
+# variables, before processing a man page.
#
# Arguments:
# None.
proc initGlobals {} {
global file noFillCount textState
- global fontStart fontEnd curFont inPRE charCnt
+ global fontStart fontEnd curFont inPRE charCnt inTable
nest init
set inPRE 0
+ set inTable 0
set textState 0
set curFont ""
set fontStart(Code) "<B>"
@@ -60,12 +63,12 @@ proc initGlobals {} {
set charCnt 0
setTabs 0.5i
}
-
-
+
+##############################################################################
# beginFont --
#
-# Arranges for future text to use a special font, rather than
-# the default paragraph font.
+# Arranges for future text to use a special font, rather than the default
+# paragraph font.
#
# Arguments:
# font - Name of new font to use.
@@ -73,7 +76,7 @@ proc initGlobals {} {
proc beginFont font {
global curFont file fontStart
- if {$curFont == $font} {
+ if {$curFont eq $font} {
return
}
endFont
@@ -81,7 +84,7 @@ proc beginFont font {
set curFont $font
}
-
+##############################################################################
# endFont --
#
# Reverts to the default font for the paragraph type.
@@ -92,86 +95,92 @@ proc beginFont font {
proc endFont {} {
global curFont file fontEnd
- if {$curFont != ""} {
- puts -nonewline $file $fontEnd($curFont)
- set curFont ""
+ if {$curFont ne ""} {
+ puts -nonewline $file $fontEnd($curFont)
+ set curFont ""
}
}
-
-
-
+
+##############################################################################
# text --
#
-# This procedure adds text to the current paragraph. If this is
-# the first text in the paragraph then header information for the
-# paragraph is output before the text.
+# This procedure adds text to the current paragraph. If this is the first text
+# in the paragraph then header information for the paragraph is output before
+# the text.
#
# Arguments:
# string - Text to output in the paragraph.
proc text string {
- global file textState inDT charCnt
+ global file textState inDT charCnt inTable
set pos [string first "\t" $string]
if {$pos >= 0} {
text [string range $string 0 [expr $pos-1]]
tab
text [string range $string [expr $pos+1] end]
- return
+ return
+ }
+ if {$inTable} {
+ if {$inTable == 1} {
+ puts -nonewline $file <TR>
+ set inTable 2
+ }
+ puts -nonewline $file <TD>
}
incr charCnt [string length $string]
regsub -all {&} $string {\&amp;} string
regsub -all {<} $string {\&lt;} string
regsub -all {>} $string {\&gt;} string
- regsub -all {"} $string {\&quot;} string
- switch $textState {
- REF {
- if {$inDT == {}} {
+ regsub -all \" $string {\&quot;} string
+ switch -exact -- $textState {
+ REF {
+ if {$inDT eq ""} {
set string [insertRef $string]
}
}
- SEE {
+ SEE {
global NAME_file
foreach i [split $string] {
- if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] {
+ if {![regexp -nocase {^[a-z_]+} [string trim $i] i]} {
# puts "Warning: $i in SEE ALSO not found"
continue
}
- if ![catch {set ref $NAME_file($i)} ] {
+ if {![catch { set ref $NAME_file($i) }]} {
regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
}
}
}
}
puts -nonewline $file "$string"
+ if {$inTable} {
+ puts -nonewline $file </TD>
+ }
}
-
-
+##############################################################################
# insertRef --
#
-#
# Arguments:
# string - Text to output in the paragraph.
proc insertRef string {
global NAME_file self
set path {}
- if ![catch {set ref $NAME_file([string trim $string])} ] {
- if {"$ref.html" != $self} {
+ if {![catch { set ref $NAME_file([string trim $string]) }]} {
+ if {"$ref.html" ne $self} {
set string "<A HREF=\"${path}$ref.html\">$string</A>"
# puts "insertRef: $self $ref.html ---$string--"
}
}
return $string
}
-
-
-
+
+##############################################################################
# macro --
#
-# This procedure is invoked to process macro invocations that start
-# with "." (instead of ').
+# This procedure is invoked to process macro invocations that start with "."
+# (instead of ').
#
# Arguments:
# name - The name of the macro (without the ".").
@@ -195,7 +204,7 @@ proc macro {name args} {
}
AS {} ;# next page and previous page
br {
- lineBreak
+ lineBreak
}
BS {}
BE {}
@@ -210,16 +219,16 @@ proc macro {name args} {
set inPRE 1
}
DE {
- global file noFillCount inPRE
- puts $file </PRE></BLOCKQUOTE>
- set inPRE 0
+ global file noFillCount inTable
+ puts $file </TABLE></BLOCKQUOTE>
+ set inTable 0
set noFillCount 0
}
DS {
- global file noFillCount inPRE
- puts -nonewline $file <BLOCKQUOTE><PRE>
+ global file noFillCount inTable
+ puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">}
set noFillCount 10000000
- set inPRE 1
+ set inTable 1
}
fi {
global noFillCount
@@ -240,13 +249,13 @@ proc macro {name args} {
set noFillCount 1000000
}
OP {
- global inDT file inPRE
+ global inDT file inPRE
if {[llength $args] != 3} {
puts stderr "Bad .OP macro: .$name [join $args " "]"
}
nest para DL DT
set inPRE 1
- puts -nonewline $file <PRE>
+ puts -nonewline $file <PRE>
setTabs 4c
text "Command-Line Name:"
tab
@@ -267,8 +276,8 @@ proc macro {name args} {
font B
text [lindex $args 2]
font R
- puts -nonewline $file </PRE>
- set inDT "\n<DD>" ;# next newline writes inDT
+ puts -nonewline $file </PRE>
+ set inDT "\n<DD>" ;# next newline writes inDT
set inPRE 0
newline
}
@@ -278,7 +287,7 @@ proc macro {name args} {
newPara
}
RE {
- nest decr
+ nest decr
}
RS {
nest incr
@@ -296,7 +305,11 @@ proc macro {name args} {
font B
set temp $textState
set textState REF
- text options
+ if {[llength $args] > 0} {
+ text [lindex $args 0]
+ } else {
+ text options
+ }
set textState $temp
font R
text " manual entry for detailed descriptions of the above options."
@@ -304,6 +317,9 @@ proc macro {name args} {
SH {
SHmacro $args
}
+ SS {
+ SHmacro $args subsection
+ }
SO {
global noFillCount inPRE file
@@ -315,12 +331,12 @@ proc macro {name args} {
font B
}
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]
@@ -359,6 +375,43 @@ proc macro {name args} {
# }
# puts -nonewline $file "<FONT COLOR=\"GREEN\">"
}
+ QW {
+ puts -nonewline $file "&\#147;"
+ text [lindex $args 0]
+ puts -nonewline $file "&\#148;"
+ if {[llength $args] > 1} {
+ text [lindex $args 1]
+ }
+ }
+ PQ {
+ puts -nonewline $file "(&\#147;"
+ if {[lindex $args 0] eq {\N'34'}} {
+ puts -nonewline $file \"
+ } else {
+ text [lindex $args 0]
+ }
+ puts -nonewline $file "&\#148;"
+ if {[llength $args] > 1} {
+ text [lindex $args 1]
+ }
+ puts -nonewline $file ")"
+ if {[llength $args] > 2} {
+ text [lindex $args 2]
+ }
+ }
+ QR {
+ puts -nonewline $file "&\#147;"
+ text [lindex $args 0]
+ puts -nonewline $file "&\#148;&\#150;&\#147;"
+ text [lindex $args 1]
+ puts -nonewline $file "&\#148;"
+ if {[llength $args] > 2} {
+ text [lindex $args 2]
+ }
+ }
+ MT {
+ puts -nonewline $file "&\#147;&\#148;"
+ }
default {
puts stderr "Unknown macro: .$name [join $args " "]"
}
@@ -367,12 +420,11 @@ proc macro {name args} {
# global nestStk; puts "$name [format "%-20s" $args] $nestStk"
# flush stdout; flush stderr
}
-
-
+
+##############################################################################
# font --
#
-# This procedure is invoked to handle font changes in the text
-# being output.
+# This procedure is invoked to handle font changes in the text being output.
#
# Arguments:
# type - Type of font: R, I, B, or S.
@@ -383,13 +435,13 @@ proc font type {
P -
R {
endFont
- if {$textState == "REF"} {
+ if {$textState eq "REF"} {
set textState INSERT
}
}
B {
beginFont Code
- if {$textState == "INSERT"} {
+ if {$textState eq "INSERT"} {
set textState REF
}
}
@@ -403,20 +455,19 @@ proc font type {
}
}
}
-
-
-
+
+##############################################################################
# formattedText --
#
-# Insert a text string that may also have \fB-style font changes
-# and a few other backslash sequences in it.
+# 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 {
# puts "formattedText: $text"
- while {$text != ""} {
+ while {$text ne ""} {
set index [string first \\ $text]
if {$index < 0} {
text $text
@@ -447,37 +498,35 @@ proc formattedText text {
}
}
}
-
-
-
+
+##############################################################################
# dash --
#
-# This procedure is invoked to handle dash characters ("\-" in
-# troff). It outputs a special dash character.
+# This procedure is invoked to handle dash characters ("\-" in troff). It
+# outputs a special dash character.
#
# Arguments:
# None.
proc dash {} {
global textState charCnt
- if {$textState == "NAME"} {
+ if {$textState eq "NAME"} {
set textState 0
}
incr charCnt
text "-"
}
-
-
+
+##############################################################################
# tab --
#
# This procedure is invoked to handle tabs in the troff input.
-# Right now it does nothing.
#
# Arguments:
# None.
proc tab {} {
- global inPRE charCnt tabString
+ global inPRE charCnt tabString file
# ? charCnt
if {$inPRE == 1} {
set pos [expr $charCnt % [string length $tabString] ]
@@ -488,7 +537,7 @@ proc tab {} {
}
}
-
+##############################################################################
# setTabs --
#
# This procedure handles the ".ta" macro, which sets tab stops.
@@ -500,38 +549,52 @@ proc tab {} {
proc setTabs {tabList} {
global file breakPending tabString
-# puts "setTabs: --$tabList--"
+ # puts "setTabs: --$tabList--"
set last 0
set tabString {}
set charsPerInch 14.
set numTabs [llength $tabList]
foreach arg $tabList {
- if {[scan $arg "%f%s" distance units] != 2} {
- puts stderr "bad distance \"$arg\""
- return 0
- }
- switch -- $units {
- c {
- set distance [expr $distance * $charsPerInch / 2.54 ]
- }
- i {
- set distance [expr $distance * $charsPerInch]
+ if {[string match +* $arg]} {
+ set relative 1
+ set arg [string range $arg 1 end]
+ } else {
+ set relative 0
+ }
+ # Always operate in relative mode for "measurement" mode
+ if {[regexp {^\\w'(.*)'u$} $arg content]} {
+ set distance [string length $content]
+ } else {
+ if {[scan $arg "%f%s" distance units] != 2} {
+ puts stderr "bad distance \"$arg\""
+ return 0
}
- default {
- puts stderr "bad units in distance \"$arg\""
- continue
+ switch -- $units {
+ c {
+ set distance [expr {$distance * $charsPerInch / 2.54}]
+ }
+ i {
+ set distance [expr {$distance * $charsPerInch}]
+ }
+ default {
+ puts stderr "bad units in distance \"$arg\""
+ continue
+ }
}
- }
-# ? distance
- lappend tabString [format "%*s1" [expr round($distance-$last-1)] " "]
- set last $distance
+ }
+ # ? distance
+ if {$relative} {
+ append tabString [format "%*s1" [expr {round($distance-1)}] " "]
+ set last [expr {$last + $distance}]
+ } else {
+ append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
+ set last $distance
+ }
}
- set tabString [join $tabString {}]
-# puts "setTabs: --$tabString--"
+ # puts "setTabs: --$tabString--"
}
-
-
-
+
+##############################################################################
# lineBreak --
#
# Generates a line break in the HTML output.
@@ -544,23 +607,26 @@ proc lineBreak {} {
puts $file "<BR>"
}
-
-
+##############################################################################
# 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.
+# 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 noFillCount file inDT inPRE charCnt
+ global noFillCount file inDT inPRE charCnt inTable
- if {$inDT != {} } {
+ if {$inDT ne ""} {
puts $file "\n$inDT"
set inDT {}
+ } elseif {$inTable} {
+ if {$inTable > 1} {
+ puts $file </tr>
+ set inTable 1
+ }
} elseif {$noFillCount == 0 || $inPRE == 1} {
puts $file {}
} else {
@@ -569,9 +635,8 @@ proc newline {} {
}
set charCnt 0
}
-
-
-
+
+##############################################################################
# char --
#
# This procedure is called to handle a special character.
@@ -602,13 +667,12 @@ proc char name {
}
}
}
-
-
+
+##############################################################################
# macro2 --
#
-# This procedure handles macros that are invoked with a leading "'"
-# character instead of space. Right now it just generates an
-# error diagnostic.
+# 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 ".").
@@ -617,17 +681,17 @@ proc char name {
proc macro2 {name args} {
puts stderr "Unknown macro: '$name [join $args " "]"
}
-
-
-
+
+##############################################################################
# SHmacro --
#
-# Subsection head; handles the .SH macro.
+# Subsection head; handles the .SH and .SS macros.
#
# Arguments:
# name - Section name.
+# style - Type of section (optional)
-proc SHmacro argList {
+proc SHmacro {argList {style section}} {
global file noFillCount textState charCnt
set args [join $argList " "]
@@ -638,14 +702,18 @@ proc SHmacro argList {
set noFillCount 0
nest reset
- puts -nonewline $file "<H3>"
+ set tag H3
+ if {$style eq "subsection"} {
+ set tag H4
+ }
+ puts -nonewline $file "<$tag>"
text $args
- puts $file "</H3>"
+ puts $file "</$tag>"
# ? args textState
# control what the text proc does with text
-
+
switch $args {
NAME {set textState NAME}
DESCRIPTION {set textState INSERT}
@@ -656,20 +724,20 @@ proc SHmacro argList {
}
set charCnt 0
}
-
-
-
+
+##############################################################################
# IPmacro --
#
-# This procedure is invoked to handle ".IP" macros, which may take any
-# of the following forms:
+# This procedure is invoked to handle ".IP" macros, which may take any of the
+# following forms:
#
# .IP [1] Translate to a "1Step" paragraph.
-# .IP [x] (x > 1) Translate to a "Step" paragraph.
+# .IP [x] (x > 1) Translate to a "Step" paragraph.
# .IP Translate to a "Bullet" paragraph.
-# .IP text count Translate to a FirstBody paragraph with special
-# indent and tab stop based on "count", and tab after
-# "text".
+# .IP \(bu Translate to a "Bullet" paragraph.
+# .IP text count Translate to a FirstBody paragraph with
+# special indent and tab stop based on "count",
+# and tab after "text".
#
# Arguments:
# argList - List of arguments to the .IP macro.
@@ -685,50 +753,49 @@ proc IPmacro argList {
nest para UL LI
return
}
- if {$length == 1} {
+ # Special case for alternative mechanism for declaring bullets
+ if {[lindex $argList 0] eq "\\(bu"} {
+ nest para UL LI
+ return
+ }
+ if {[regexp {^\[\d+\]$} [lindex $argList 0]]} {
nest para OL LI
- return
- }
- if {$length > 1} {
- nest para DL DT
- formattedText [lindex $argList 0]
- puts $file "\n<DD>"
- return
+ return
}
- puts stderr "Bad .IP macro: .IP [join $argList " "]"
+ nest para DL DT
+ formattedText [lindex $argList 0]
+ puts $file "\n<DD>"
+ return
}
-
-
+
+##############################################################################
# TPmacro --
#
-# This procedure is invoked to handle ".TP" macros, which may take any
-# of the following forms:
+# This procedure is invoked to handle ".TP" macros, which may take any of the
+# following forms:
#
-# .TP x Translate to an indented paragraph with the
-# specified indent (in 100 twip units).
-# .TP Translate to an indented paragraph with
-# default indent.
+# .TP x Translate to an indented paragraph with the specified indent
+# (in 100 twip units).
+# .TP Translate to an indented paragraph with default indent.
#
# Arguments:
# argList - List of arguments to the .IP macro.
#
# HTML limitations: 'x' in '.TP x' is ignored.
-
proc TPmacro {argList} {
global inDT
nest para DL DT
- set inDT "\n<DD>" ;# next newline writes inDT
+ set inDT "\n<DD>" ;# next newline writes inDT
setTabs 0.5i
}
-
-
-
+
+##############################################################################
# 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:
+# 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
#
@@ -751,54 +818,52 @@ proc THmacro {argList} {
puts -nonewline $file "<HTML><HEAD><TITLE>"
text "$lib - $name ($page)"
puts $file "</TITLE></HEAD><BODY>\n"
-
+
puts -nonewline $file "<H1><CENTER>"
text $pname
puts $file "</CENTER></H1>\n"
}
-
-
-
+
+##############################################################################
# newPara --
#
-# This procedure sets the left and hanging indents for a line.
-# Indents are specified in units of inches or centimeters, and are
-# relative to the current nesting level and left margin.
+# This procedure sets the left and hanging indents for a line. Indents are
+# specified in units of inches or centimeters, and are relative to the current
+# nesting level and left margin.
#
# Arguments:
# None
proc newPara {} {
global file nestStk
-
- if {[lindex $nestStk end] != "NEW" } {
- nest decr
+
+ if {[lindex $nestStk end] ne "NEW"} {
+ nest decr
}
puts -nonewline $file "<P>"
}
-
-
-
+
+##############################################################################
# nest --
#
-# This procedure takes care of inserting the tags associated with the
-# IP, TP, RS, RE, LP and PP macros. Only 'nest para' takes arguments.
+# This procedure takes care of inserting the tags associated with the IP, TP,
+# RS, RE, LP and PP macros. Only 'nest para' takes arguments.
#
# Arguments:
# op - operation: para, incr, decr, reset, init
# listStart - begin list tag: OL, UL, DL.
# listItem - item tag: LI, LI, DT.
-proc nest {op {listStart "NEW"} {listItem {} } } {
+proc nest {op {listStart "NEW"} {listItem ""} } {
global file nestStk inDT charCnt
# puts "nest: $op $listStart $listItem"
switch $op {
para {
set top [lindex $nestStk end]
- if {$top == "NEW" } {
+ if {$top eq "NEW"} {
set nestStk [lreplace $nestStk end end $listStart]
puts $file "<$listStart>"
- } elseif {$top != $listStart} {
+ } elseif {$top ne $listStart} {
puts stderr "nest para: bad stack"
exit 1
}
@@ -814,7 +879,7 @@ proc nest {op {listStart "NEW"} {listItem {} } } {
set nestStk NEW
}
set tag [lindex $nestStk end]
- if {$tag != "NEW"} {
+ if {$tag ne "NEW"} {
puts $file "</$tag>"
}
set nestStk [lreplace $nestStk end end]
@@ -832,14 +897,13 @@ proc nest {op {listStart "NEW"} {listItem {} } } {
}
set charCnt 0
}
-
-
-
+
+##############################################################################
# do --
#
-# This is the toplevel procedure that translates a man page
-# to Frame. It runs the man2tcl program to turn the man page
-# into a script, then it evals that script.
+# This is the toplevel procedure that translates a man page to HTML. It runs
+# the man2tcl program to turn the man page into a script, then it evals that
+# script.
#
# Arguments:
# fileName - Name of the file to translate.
@@ -851,7 +915,7 @@ proc do fileName {
puts " Pass 2 -- $fileName"
flush stdout
initGlobals
- if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
+ if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
global errorInfo
puts stderr $msg
puts "in"
@@ -863,6 +927,3 @@ proc do fileName {
puts $file "</BODY></HTML>"
close $file
}
-
-
-
generated by cgit v0.12 at 2024-11-07 09:23:33 (GMT)