##############################################################################
# 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.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# $Id: man2html2.tcl,v 1.13 2007/12/13 15:28:40 dgp Exp $
#
package require Tcl 8.4
# Global variables used by these scripts:
#
# 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.
#
# 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.
#
# file - Where to output the generated HTML.
#
# fontStart - Array to map font names to starting sequences.
#
# 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.
#
# 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.
#
# Arguments:
# None.
proc initGlobals {} {
global file noFillCount textState
global fontStart fontEnd curFont inPRE charCnt inTable
nest init
set inPRE 0
set inTable 0
set textState 0
set curFont ""
set fontStart(Code) "<B>"
set fontStart(Emphasis) "<I>"
set fontEnd(Code) "</B>"
set fontEnd(Emphasis) "</I>"
set noFillCount 0
set charCnt 0
setTabs 0.5i
}
##############################################################################
# beginFont --
#
# Arranges for future text to use a special font, rather than the default
# paragraph font.
#
# Arguments:
# font - Name of new font to use.
proc beginFont font {
global curFont file fontStart
if {$curFont eq $font} {
return
}
endFont
puts -nonewline $file $fontStart($font)
set curFont $font
}
##############################################################################
# endFont --
#
# Reverts to the default font for the paragraph type.
#
# Arguments:
# None.
proc endFont {} {
global curFont file fontEnd
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.
#
# Arguments:
# string - Text to output in the paragraph.
proc text string {
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
}
if {$inTable} {
if {$inTable == 1} {
puts -nonewline $file <TR>
set inTable 2
}
puts -nonewline $file <TD>
}
incr charCnt [string length $string]
regsub -all {&} $string {\&} string
regsub -all {<} $string {\<} string
regsub -all {>} $string {\>} string
regsub -all \" $string {\"} string
switch -exact -- $textState {
REF {
if {$inDT eq ""} {
set string [insertRef $string]
}
}
SEE {
global NAME_file
foreach i [split $string] {
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) }]} {
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" 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 ').
#
# Arguments:
# name - The name of the macro (without the ".").
# args - Any additional arguments to the macro.
proc macro {name args} {
switch $name {
AP {
if {[llength $args] != 3} {
puts stderr "Bad .AP macro: .$name [join $args " "]"
}
setTabs {1.25i 2.5i 3.75i}
TPmacro {}
font B
text "[lindex $args 0] "
font I
text "[lindex $args 1]"
font R
text " ([lindex $args 2])"
newline
}
AS {} ;# next page and previous page
br {
lineBreak
}
BS {}
BE {}
CE {
global file noFillCount inPRE
puts $file </PRE></BLOCKQUOTE>
set inPRE 0
}
CS { ;# code section
global file noFillCount inPRE
puts -nonewline $file <BLOCKQUOTE><PRE>
set inPRE 1
}
DE {
global file noFillCount inTable
puts $file </TABLE></BLOCKQUOTE>
set inTable 0
set noFillCount 0
}
DS {
global file noFillCount inTable
puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">}
set noFillCount 10000000
set inTable 1
}
fi {
global noFillCount
set noFillCount 0
}
IP {
IPmacro $args
}
LP {
nest decr
nest incr
newPara
}
ne {
}
nf {
global noFillCount
set noFillCount 1000000
}
OP {
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>
setTabs 4c
text "Command-Line Name:"
tab
font B
set x [lindex $args 0]
regsub -all {\\-} $x - x
text $x
newline
font R
text "Database Name:"
tab
font B
text [lindex $args 1]
newline
font R
text "Database Class:"
tab
font B
text [lindex $args 2]
font R
puts -nonewline $file </PRE>
set inDT "\n<DD>" ;# next newline writes inDT
set inPRE 0
newline
}
PP {
nest decr
nest incr
newPara
}
RE {
nest decr
}
RS {
nest incr
}
SE {
global noFillCount textState inPRE file
font R
puts -nonewline $file </PRE>
set inPRE 0
set noFillCount 0
nest reset
newPara
text "See the "
font B
set temp $textState
set textState REF
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."
}
SH {
SHmacro $args
}
SS {
SHmacro $args subsection
}
SO {
global noFillCount inPRE file
SHmacro "STANDARD OPTIONS"
setTabs {4c 8c 12c}
set noFillCount 1000000
puts -nonewline $file <PRE>
set inPRE 1
font B
}
so {
if {$args ne "man.macros"} {
puts stderr "Unknown macro: .$name [join $args " "]"
}
}
sp { ;# needs work
if {$args eq ""} {
set count 1
} else {
set count [lindex $args 0]
}
while {$count > 0} {
lineBreak
incr count -1
}
}
ta {
setTabs $args
}
TH {
THmacro $args
}
TP {
TPmacro $args
}
UL { ;# underline
global file
puts -nonewline $file "<B><U>"
text [lindex $args 0]
puts -nonewline $file "</U></B>"
if {[llength $args] == 2} {
text [lindex $args 1]
}
}
VE {
# global file
# puts -nonewline $file "</FONT>"
}
VS {
# global file
# if {[llength $args] > 0} {
# puts -nonewline $file "<BR>"
# }
# 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 " "]"
}
}
# 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.
#
# Arguments:
# type - Type of font: R, I, B, or S.
proc font type {
global textState
switch $type {
P -
R {
endFont
if {$textState eq "REF"} {
set textState INSERT
}
}
B {
beginFont Code
if {$textState eq "INSERT"} {
set textState REF
}
}
I {
beginFont Emphasis
}
S {
}
default {
puts stderr "Unknown font: $type"
}
}
}
##############################################################################
# formattedText --
#
# 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 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]]
switch -- $c {
f {
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]
}
- {
dash
set text [string range $text [expr $index+2] end]
}
| {
set text [string range $text [expr $index+2] end]
}
default {
puts stderr "Unknown sequence: \\$c"
set text [string range $text [expr $index+2] end]
}
}
}
}
##############################################################################
# dash --
#
# 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 eq "NAME"} {
set textState 0
}
incr charCnt
text "-"
}
##############################################################################
# tab --
#
# This procedure is invoked to handle tabs in the troff input.
#
# Arguments:
# None.
proc tab {} {
global inPRE charCnt tabString file
# ? charCnt
if {$inPRE == 1} {
set pos [expr $charCnt % [string length $tabString] ]
set spaces [string first "1" [string range $tabString $pos end] ]
text [format "%*s" [incr spaces] " "]
} else {
# puts "tab: found tab outside of <PRE> block"
}
}
##############################################################################
# setTabs --
#
# 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).
proc setTabs {tabList} {
global file breakPending tabString
# puts "setTabs: --$tabList--"
set last 0
set tabString {}
set charsPerInch 14.
set numTabs [llength $tabList]
foreach arg $tabList {
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
}
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
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
}
}
# puts "setTabs: --$tabString--"
}
##############################################################################
# lineBreak --
#
# Generates a line break in the HTML output.
#
# Arguments:
# None.
proc lineBreak {} {
global file inPRE
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.
#
# Arguments:
# None.
proc newline {} {
global noFillCount file inDT inPRE charCnt inTable
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 {
lineBreak
incr noFillCount -1
}
set charCnt 0
}
##############################################################################
# char --
#
# This procedure is called to handle a special character.
#
# Arguments:
# name - Special character named in troff \x or \(xx construct.
proc char name {
global file charCnt
incr charCnt
# puts "char: $name"
switch -exact $name {
\\0 { ;# \0
puts -nonewline $file " "
}
\\\\ { ;# \
puts -nonewline $file "\\"
}
\\(+- { ;# +/-
puts -nonewline $file "±"
}
\\% {} ;# \%
\\| { ;# \|
}
default {
puts stderr "Unknown character: $name"
}
}
}
##############################################################################
# macro2 --
#
# 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 ".").
# args - Any additional arguments to the macro.
proc macro2 {name args} {
puts stderr "Unknown macro: '$name [join $args " "]"
}
##############################################################################
# SHmacro --
#
# Subsection head; handles the .SH and .SS macros.
#
# Arguments:
# name - Section name.
# style - Type of section (optional)
proc SHmacro {argList {style section}} {
global file noFillCount textState charCnt
set args [join $argList " "]
if {[llength $argList] < 1} {
puts stderr "Bad .SH macro: .$name $args"
}
set noFillCount 0
nest reset
set tag H3
if {$style eq "subsection"} {
set tag H4
}
puts -nonewline $file "<$tag>"
text $args
puts $file "</$tag>"
# ? args textState
# control what the text proc does with text
switch $args {
NAME {set textState NAME}
DESCRIPTION {set textState INSERT}
INTRODUCTION {set textState INSERT}
"WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
"SEE ALSO" {set textState SEE}
KEYWORDS {set textState 0}
}
set charCnt 0
}
##############################################################################
# IPmacro --
#
# 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 Translate to a "Bullet" paragraph.
# .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.
#
# HTML limitations: 'count' in '.IP text count' is ignored.
proc IPmacro argList {
global file
setTabs 0.5i
set length [llength $argList]
if {$length == 0} {
nest para UL LI
return
}
# 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
}
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:
#
# .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
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:
#
# .TH name section date footer header
#
# Arguments:
# argList - List of arguments to the .TH macro.
proc THmacro {argList} {
global file
if {[llength $argList] != 5} {
set args [join $argList " "]
puts stderr "Bad .TH macro: .$name $args"
}
set name [lindex $argList 0] ;# Tcl_UpVar
set page [lindex $argList 1] ;# 3
set vers [lindex $argList 2] ;# 7.4
set lib [lindex $argList 3] ;# Tcl
set pname [lindex $argList 4] ;# {Tcl Library Procedures}
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.
#
# Arguments:
# None
proc newPara {} {
global file nestStk
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.
#
# 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 ""} } {
global file nestStk inDT charCnt
# puts "nest: $op $listStart $listItem"
switch $op {
para {
set top [lindex $nestStk end]
if {$top eq "NEW"} {
set nestStk [lreplace $nestStk end end $listStart]
puts $file "<$listStart>"
} elseif {$top ne $listStart} {
puts stderr "nest para: bad stack"
exit 1
}
puts $file "\n<$listItem>"
set charCnt 0
}
incr {
lappend nestStk NEW
}
decr {
if {[llength $nestStk] == 0} {
puts stderr "nest error: nest length is zero"
set nestStk NEW
}
set tag [lindex $nestStk end]
if {$tag ne "NEW"} {
puts $file "</$tag>"
}
set nestStk [lreplace $nestStk end end]
}
reset {
while {[llength $nestStk] > 0} {
nest decr
}
set nestStk NEW
}
init {
set nestStk NEW
set inDT {}
}
}
set charCnt 0
}
##############################################################################
# do --
#
# 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.
proc do fileName {
global file self html_dir package footer
set self "[file tail $fileName].html"
set file [open "$html_dir/$package/$self" w]
puts " Pass 2 -- $fileName"
flush stdout
initGlobals
if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
global errorInfo
puts stderr $msg
puts "in"
puts stderr $errorInfo
exit 1
}
nest reset
puts $file $footer
puts $file "</BODY></HTML>"
close $file
}
|
