proc initGlobals {} {
uplevel \ global state chars
set state(paragraphPending) 0
set state(breakPending) 0
set state(firstIndent) 0
set state(leftIndent) 0
set state(inTP) 0
set state(paragraph) 0
set state(textState) 0
set state(curFont) ""
set state(startCode) "{\\b "
set state(startEmphasis) "{\\i "
set state(endCode) "}"
set state(endEmphasis) "}"
set state(noFill) 0
set state(charCnt) 0
set state(offset) [getTwips 0.5i]
set state(leftMargin) [getTwips 0.5i]
set state(nestingLevel) 0
set state(intl) 0
set state(sb) 0
setTabs 0.5i
array set chars {
o^ F4
}
}
proc beginFont {font} {
global file state
textSetup
if {[string equal $state(curFont) $font]} {
return
}
endFont
puts -nonewline $file $state(start$font)
set state(curFont) $font
}
proc endFont {} {
global state file
if {[string compare $state(curFont) ""]} {
puts -nonewline $file $state(end$state(curFont))
set state(curFont) ""
}
}
proc textSetup {} {
global file state
if $state(breakPending) {
puts $file "\\line"
}
if $state(paragraphPending) {
puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \
$state(firstIndent) $state(leftIndent)]
foreach tab $state(tabs) {
puts $file [format "\\tx%.0f" $tab]
}
set state(tabs) {}
if {$state(sb)} {
puts $file "\\sb$state(sb)"
set state(sb) 0
}
}
set state(breakPending) 0
set state(paragraphPending) 0
}
proc text {string} {
global file state chars
textSetup
set string [string map [list \
"\\" "\\\\" \
"\{" "\\\{" \
"\}" "\\\}" \
"\t" {\tab } \
'' "\\rdblquote " \
`` "\\ldblquote " \
] $string]
if {$state(intl)} {
if {[regexp {^'([^']*)'} $string dummy ch]} {
if {[info exists chars($ch)]} {
regsub {^'[^']*'} $string "\\\\'$chars($ch)" string
} else {
puts stderr "Unknown international character '$ch'"
}
}
set state(intl) 0
}
switch $state(textState) {
REF {
if {$state(inTP) == 0} {
set string [insertRef $string]
}
}
SEE {
global topics curPkg curSect
foreach i [split $string] {
if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
continue
}
if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} {
regsub $i $string [link $i $ref] string
}
}
}
KEY {
return
}
}
puts -nonewline $file "$string"
}
proc insertRef {string} {
global NAME_file curPkg curSect topics curID
set path {}
set string [string trim $string]
set ref {}
if {[info exists topics($curPkg,$curSect,$string)]} {
set ref $topics($curPkg,$curSect,$string)
} else {
set sites [array names topics "$curPkg,*,$string"]
set count [llength $sites]
if {$count > 0} {
set ref $topics([lindex $sites 0])
} else {
set sites [array names topics "*,*,$string"]
set count [llength $sites]
if {$count > 0} {
set ref $topics([lindex $sites 0])
}
}
}
if {($ref != {}) && ($ref != $curID)} {
set string [link $string $ref]
}
return $string
}
proc macro {name args} {
global state file
switch $name {
AP {
if {[llength $args] != 3 && [llength $args] != 2} {
puts stderr "Bad .AP macro: .$name [join $args " "]"
}
newPara 3.75i -3.75i
setTabs {1.25i 2.5i 3.75i}
font B
text [lindex $args 0]
tab
font I
text [lindex $args 1]
tab
font R
if {[llength $args] == 3} {
text "([lindex $args 2])"
}
tab
}
AS {
}
br {
lineBreak
}
BS {}
BE {}
CE {
puts -nonewline $::file "\\f0\\fs20 "
set state(noFill) 0
set state(breakPending) 0
newPara ""
set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}]
set state(sb) 80
}
CS {
set state(noFill) 1
newPara ""
set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}]
set state(sb) 80
puts -nonewline $::file "\\f1\\fs18 "
}
DE {
set state(noFill) 0
decrNestingLevel
newPara 0i
}
DS {
set state(noFill) 1
incrNestingLevel
newPara 0i
}
fi {
set state(noFill) 0
}
IP {
IPmacro $args
}
LP {
newPara 0i
set state(sb) 80
}
ne {
}
nf {
set state(noFill) 1
}
OP {
if {[llength $args] != 3} {
puts stderr "Bad .OP macro: .$name [join $args " "]"
}
set state(nestingLevel) 0
newPara 0i
set state(sb) 120
setTabs 4c
text "Command-Line Name:"
tab
font B
set x [lindex $args 0]
regsub -all {\\-} $x - x
text $x
lineBreak
font R
text "Database Name:"
tab
font B
text [lindex $args 1]
lineBreak
font R
text "Database Class:"
tab
font B
text [lindex $args 2]
font R
set state(inTP) 0
newPara 0.5i
set state(sb) 80
}
PP {
newPara 0i
set state(sb) 120
}
RE {
decrNestingLevel
}
RS {
incrNestingLevel
}
SE {
font R
set state(noFill) 0
set state(nestingLevel) 0
newPara 0i
text "See the "
font B
set temp $state(textState)
set state(textState) REF
text options
set state(textState) $temp
font R
text " manual entry for detailed descriptions of the above options."
}
SH {
SHmacro $args
}
SO {
SHmacro "STANDARD OPTIONS"
set state(nestingLevel) 0
newPara 0i
setTabs {4c 8c 12c}
font B
set state(noFill) 1
}
so {
if {$args != "man.macros"} {
puts stderr "Unknown macro: .$name [join $args " "]"
}
}
sp { ; if {$args == ""} {
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 { ; puts -nonewline $file "{\\ul "
text [lindex $args 0]
puts -nonewline $file "}"
if {[llength $args] == 2} {
text [lindex $args 1]
}
}
VE {}
VS {}
default {
puts stderr "Unknown macro: .$name [join $args " "]"
}
}
}
proc link {label id} {
return "{\\uldb $label}{\\v $id}"
}
proc font {type} {
global state
switch $type {
P -
R {
endFont
if {$state(textState) == "REF"} {
set state(textState) INSERT
}
}
C -
B {
beginFont Code
if {$state(textState) == "INSERT"} {
set state(textState) REF
}
}
I {
beginFont Emphasis
}
S {
}
default {
puts stderr "Unknown font: $type"
}
}
}
proc formattedText {text} {
global chars
while {$text != ""} {
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]
}
o {
text "\\'"
regexp {'([^']*)'(.*)} $text all ch text
text $chars($ch)
}
default {
puts stderr "Unknown sequence: \\$c"
set text [string range $text [expr {$index+2}] end]
}
}
}
}
proc dash {} {
global state
if {[string equal $state(textState) "NAME"]} {
set state(textState) 0
}
text "-"
}
proc tab {} {
global file
textSetup
puts -nonewline $file "\\tab "
}
proc setTabs {tabList} {
global file state
set state(tabs) {}
foreach arg $tabList {
set distance [expr {$state(leftMargin) \
+ ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}]
lappend state(tabs) [expr {round($distance)}]
}
}
proc lineBreak {} {
global state
textSetup
set state(breakPending) 1
}
proc newline {} {
global state
if {$state(inTP)} {
set state(inTP) 0
lineBreak
} elseif {$state(noFill)} {
lineBreak
} else {
text " "
}
}
proc pageBreak {} {
global file curVer
if {[string equal $curVer ""]} {
puts $file {\page}
} else {
puts $file {\par}
puts $file {\pard\sb400\qc}
puts $file "Last change: $curVer\\page"
}
}
proc char {name} {
global file state
switch -exact $name {
\\o {
set state(intl) 1
}
\\\ {
textSetup
puts -nonewline $file " "
}
\\0 {
textSetup
puts -nonewline $file " \\emspace "
}
\\\\ {
textSetup
puts -nonewline $file "\\\\"
}
\\(+- {
textSetup
puts -nonewline $file "\\'b1 "
}
\\% -
\\| {
}
\\(bu {
textSetup
puts -nonewline $file "·"
}
default {
puts stderr "Unknown character: $name"
}
}
}
proc macro2 {name args} {
puts stderr "Unknown macro: '$name [join $args " "]"
}
proc SHmacro {argList} {
global file state
set args [join $argList " "]
if {[llength $argList] < 1} {
puts stderr "Bad .SH macro: .SH $args"
}
switch $args {
NAME {set state(textState) NAME}
DESCRIPTION {set state(textState) INSERT}
INTRODUCTION {set state(textState) INSERT}
"WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT}
"SEE ALSO" {set state(textState) SEE}
KEYWORDS {set state(textState) KEY; return}
}
if {$state(breakPending) != -1} {
set state(breakPending) 1
} else {
set state(breakPending) 0
}
set state(noFill) 0
nextPara 0i
font B
text $args
font R
nextPara .5i
}
proc IPmacro {argList} {
global file state
set length [llength $argList]
if {$length == 0} {
newPara 0.5i
return
}
if {$length == 1} {
newPara 0.5i -0.5i
set state(sb) 80
setTabs 0.5i
formattedText [lindex $argList 0]
tab
return
}
if {$length == 2} {
set count [lindex $argList 1]
set tab [expr $count * 0.1]i
newPara $tab -$tab
set state(sb) 80
setTabs $tab
formattedText [lindex $argList 0]
tab
return
}
puts stderr "Bad .IP macro: .IP [join $argList " "]"
}
proc TPmacro {argList} {
global state
set length [llength $argList]
if {$length == 0} {
set val 0.5i
} else {
set val [expr {([lindex $argList 0] * 100.0)/1440}]i
}
newPara $val -$val
setTabs $val
set state(inTP) 1
set state(sb) 120
}
proc THmacro {argList} {
global file curPkg curSect curID id_keywords state curVer bitmap
if {[llength $argList] != 5} {
set args [join $argList " "]
puts stderr "Bad .TH macro: .TH $args"
}
incr curID
set name [lindex $argList 0] ; set page [lindex $argList 1] ; set curVer [lindex $argList 2] ; set curPkg [lindex $argList 3] ; set curSect [lindex $argList 4] ;
regsub -all {\\ } $curSect { } curSect ;
puts $file "#{\\footnote $curID}" ; puts $file "\${\\footnote $name}" ; set browse "${curSect}${name}"
regsub -all {[ _-]} $browse {} browse
puts $file "+{\\footnote $browse}" ;
foreach i $id_keywords($curID) {
set keys($i) 1
}
foreach i [array names keys] {
set i [string trim $i]
if {[string length $i] > 0} {
puts $file "K{\\footnote $i}" ; }
}
unset keys
puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn"
font B
text $name
tab
text $curSect
font R
if {[info exists bitmap]} {
puts $file "\\\{bmrt $bitmap\\\}"
}
puts $file "\\fs20"
set state(breakPending) -1
}
proc nextPara {leftIndent {firstIndent 0i}} {
global state
set state(leftIndent) [getTwips $leftIndent]
set state(firstIndent) [getTwips $firstIndent]
set state(paragraphPending) 1
}
proc newPara {leftIndent {firstIndent 0i}} {
global state file
if $state(paragraph) {
puts -nonewline $file "\\line\n"
}
if {$leftIndent != ""} {
set state(leftIndent) [expr {$state(leftMargin) \
+ ($state(offset) * $state(nestingLevel)) \
+ [getTwips $leftIndent]}]
}
set state(firstIndent) [getTwips $firstIndent]
set state(paragraphPending) 1
}
proc getTwips {arg} {
if {[scan $arg "%f%s" distance units] != 2} {
puts stderr "bad distance \"$arg\""
return 0
}
switch -- $units {
c {
set distance [expr {$distance * 567}]
}
i {
set distance [expr {$distance * 1440}]
}
default {
puts stderr "bad units in distance \"$arg\""
continue
}
}
return $distance
}
proc incrNestingLevel {} {
global state
incr state(nestingLevel)
set oldp $state(paragraph)
set state(paragraph) 0
newPara 0i
set state(paragraph) $oldp
}
proc decrNestingLevel {} {
global state
if {$state(nestingLevel) == 0} {
puts stderr "Nesting level decremented below 0"
} else {
incr state(nestingLevel) -1
}
}