# -*- tcl -*-
#
# fmt.html
#
# Copyright (c) 2001-2003 Andreas Kupries
#
# Definitions to convert a tcl based manpage definition into
# a manpage based upon HTML markup.
#
################################################################
################################################################
dt_source _common.tcl ; # Shared code
dt_source _html.tcl ; # HTML basic formatting
proc c_copyrightsymbol {} {markup "©"}
proc bgcolor {} {return ""}
proc border {} {return 0}
proc Year {} {clock format [clock seconds] -format %Y}
# possibleReference text gi --
# Check if $text is a potential cross-reference;
# if so, format as a reference;
# otherwise format as a $gi element.
#
proc c_possibleReference {text gi} {
global SectionNames
if {[info exists SectionNames($text)]} {
return [taga a [list href #$SectionNames($text)]]$text[tag/ a]
} else {
return [tag $gi]$text[tag/ $gi]
}
}
c_holdBuffers require
################################################################
## Backend for HTML markup
# --------------------------------------------------------------
# Handling of lists. Simplified, the global check of nesting and
# legality of list commands allows us to throw away most of the
# existing checks.
global liststack ; # stack of list tags to use in list_end
global hintstack ; # stack of hint information.
global chint ; # current hint settings
global lmark ; # boolean flag, 1 = list item command was last
# ; # 0 = something other than a list item command
set liststack [list]
set hintstack [list]
set chint ""
set lmark 0
proc llevel {} {global liststack ; return [llength $liststack]}
proc lpush {t hint} {
global liststack hintstack chint
lappend liststack [tag/ $t]
lappend hintstack $chint
set chint $hint
return [tag $t]
}
proc lpop {} {
global liststack hintstack chint
set t [lindex $liststack end]
set liststack [lreplace $liststack end end]
set chint [lindex $hintstack end]
set hintstack [lreplace $hintstack end end]
return $t
}
proc lsmark {value} {
global lmark ; set lmark $value ; return
}
proc limark {} {
# hint and mark processing.
# hint: compact list, do not create additional whitespace
if {[lcompact]} {return ""}
# hint: wide list, create additional whitespace.
# mark: exception: two list items following each other have no whitespace.
global lmark ; if {$lmark} {return ""}
return [tag br][tag br]\n
}
proc lcompact {} {global chint ; string equal $chint compact}
proc fmt_plain_text {text} {
# Control list state
set redux [string map [list " " "" "\t" "" "\n" ""] $text]
if {$redux != {}} {lsmark 0}
return $text
}
################################################################
# Formatting commands.
c_pass 1 fmt_manpage_begin {title section version} {c_cinit ; return}
c_pass 2 fmt_manpage_begin {title section version} {
c_cinit
set module [dt_module]
set shortdesc [c_get_module]
set description [c_get_title]
set copyright [c_get_copyright]
set hdr ""
append hdr "[markup ]\n"
append hdr "[markup ]$title - $shortdesc [markup ]\n"
# Engine parameter - insert 'meta'
if {[set meta [Get meta]] != {}} {append hdr [markup $meta]\n}
append hdr "[markup ]\n"
append hdr [ht_comment [c_provenance]]\n
if {$copyright != {}} {
append hdr [ht_comment $copyright]\n
}
append hdr [ht_comment "CVS: \$Id\$ $title.$section"]\n
append hdr \n
append hdr [markup ]\n
# Engine parameter - insert 'header'
if {[set header [Get header]] != {}} {append hdr [markup $header]\n}
append hdr "[markup ] [string trimleft $title :]($section) $version $module \"$shortdesc\"[markup
]\n"
append hdr [fmt_section NAME]\n
append hdr "[fmt_para] $title - $description"
return $hdr
}
c_pass 1 fmt_moddesc {desc} {c_set_module $desc}
c_pass 2 fmt_moddesc {desc} NOP
c_pass 1 fmt_titledesc {desc} {c_set_title $desc}
c_pass 2 fmt_titledesc {desc} NOP
c_pass 1 fmt_copyright {desc} {c_set_copyright $desc}
c_pass 2 fmt_copyright {desc} NOP
c_pass 1 fmt_manpage_end {} {c_creset ; return}
c_pass 2 fmt_manpage_end {} {
c_creset
set res ""
set sa [c_xref_seealso]
set kw [c_xref_keywords]
set ct [c_get_copyright]
if {[llength $sa] > 0} {
append res [fmt_section {SEE ALSO}] \n
append res [join [XrefList [lsort $sa] sa] ", "] \n
}
if {[llength $kw] > 0} {
append res [fmt_section KEYWORDS] \n
append res [join [XrefList [lsort $kw] kw] ", "] \n
}
if {$ct != {}} {
append res [fmt_section COPYRIGHT] \n
append res [join [split $ct \n] [tag br]\n] [tag br]\n
}
# Engine parameter - insert 'footer'
if {[set footer [Get footer]] != {}} {append res [markup $footer]\n}
append res [markup ]
return $res
}
c_pass 1 fmt_section {name} { set ::SectionNames($name) [c_sectionId $name] }
c_pass 2 fmt_section {name} {
set id [c_sectionId $name]
return "[markup <]a name=[markup \"]$id[markup \">]$name[markup
\n]"
}
proc fmt_para {} {return [markup
]}
c_pass 2 fmt_require {pkg {version {}}} NOP
c_pass 1 fmt_require {pkg {version {}}} {
set result "package require [markup ]$pkg"
if {$version != {}} {
append result " $version"
}
append result [markup "
"]
c_hold require $result
return
}
c_pass 2 fmt_usage {cmd args} NOP
c_pass 1 fmt_usage {cmd args} {c_hold synopsis "[trtop][td]$cmd [join $args " "][markup ]"}
c_pass 1 fmt_call {cmd args} {
c_hold synopsis "[trtop][td][markup ""]$cmd [join $args " "][markup ]"
}
c_pass 2 fmt_call {cmd args} {
return "[fmt_lst_item "[markup ""]$cmd [join $args " "][markup ]"]\n"
}
c_pass 1 fmt_description {} NOP
c_pass 2 fmt_description {} {
set result ""
set syn [c_held synopsis]
set req [c_held require]
if {$syn != {} || $req != {}} {
append result [fmt_section SYNOPSIS]\n
}
if {$req != {}} {
append result $req \n
append result [markup
]
}
if {$syn != {}} {
proc bgcolor {} {return lightyellow}
append result [btable][tr][td][table]${syn}\n[markup ]\n
proc bgcolor {} {return ""}
}
append result [fmt_section DESCRIPTION]
return $result
}
################################################################
proc fmt_list_begin {what {hint {}}} {
switch -exact -- $what {
enum {set tag ol}
bullet {set tag ul}
arg - cmd - opt - tkoption -
definitions {set tag dl}
}
return [if {[llevel]} {limark} else {}][lpush $tag $hint][lsmark 1]
}
proc fmt_list_end {} {return [lpop][lsmark 1]}
proc fmt_lst_item {text} {return [limark][tag dt]$text[tag dd][lsmark 1]}
proc fmt_bullet {} {return [limark][tag li][lsmark 1]}
proc fmt_enum {} {return [limark][tag li][lsmark 1]}
proc fmt_cmd_def {command} {fmt_lst_item [cmd $command]}
proc fmt_arg_def {type name {mode {}}} {
set text ""
append text "$type [fmt_arg $name]"
if {$mode != {}} {
append text " ($mode)"
}
fmt_lst_item $text
}
proc fmt_opt_def {name {arg {}}} {
set text [fmt_option $name]
if {$arg != {}} {append text " $arg"}
fmt_lst_item $text
}
proc fmt_tkoption_def {name dbname dbclass} {
set text ""
append text "Command-Line Switch:\t[fmt_option $name][markup
]\n"
append text "Database Name:\t[strong $dbname][markup
]\n"
append text "Database Class:\t[strong $dbclass][markup
]\n"
fmt_lst_item $text
}
################################################################
proc fmt_example_begin {} {
lsmark 0
return [markup "
| | "]
}
proc fmt_example_end {} {
return [markup " |
"]
}
proc fmt_example {code} {
return "[fmt_example_begin][fmt_plain_text $code][fmt_example_end]"
}
proc fmt_nl {} {
if {[lcompact]} {return [tag br]}
return [tag br][tag br]
}
proc fmt_arg {text} {return "[markup ""]$text[markup ]" }
proc fmt_cmd {text} {return "[markup ""][XrefMatch $text sa][markup ]" }
proc fmt_emph {text} { em $text }
proc strong {text} {return "[markup ]$text[markup ]"}
proc em {text} {return "[markup ]$text[markup ]"}
proc fmt_opt {text} {return "?$text?" }
proc fmt_comment {text} {ht_comment $text}
proc fmt_sectref {text} {
global SectionNames
if {[info exists SectionNames($text)]} {
return "[markup <]a href=[markup \"]#$SectionNames($text)[markup \">]$text[markup ]"
} else {
return "[markup ]$text[markup ]"
}
}
proc fmt_syscmd {text} {strong [XrefMatch $text sa]}
proc fmt_method {text} {strong $text}
proc fmt_option {text} {strong $text}
proc fmt_widget {text} {strong $text}
proc fmt_fun {text} {strong $text}
proc fmt_type {text} {strong $text}
proc fmt_package {text} {strong $text}
proc fmt_class {text} {strong $text}
proc fmt_var {text} {strong $text}
proc fmt_file {text} {return "\"[strong $text]\""}
proc fmt_uri {text} {return "[markup <]a href=[markup \"]$text[markup \">]$text[markup ]"}
proc fmt_term {text} {em [XrefMatch $text kw]}
proc fmt_const {text} {strong $text}
################################################################
global xref ; array set xref {}
global __var
array set __var {
meta {}
header {}
footer {}
xref {}
}
proc Get {varname} {global __var ; return $__var($varname)}
proc fmt_listvariables {} {global __var ; return [array names __var]}
proc fmt_varset {varname text} {
global __var
if {![info exists __var($varname)]} {return -code error "Unknown engine variable \"$varname\""}
set __var($varname) $text
return
}
################################################################
proc XrefInit {} {
global xref __var
foreach item $__var(xref) {
foreach {pattern fname fragment} $item break
set fname_ref [dt_fmap $fname]
if {$fragment != {}} {append fname_ref #$fragment}
set xref($pattern) $fname_ref
}
proc XrefInit {} {}
return
}
proc XrefMatch {word ext} {
global xref
#puts_stderr "$word $ext"
#foreach {k v} [array get xref] {puts_stderr "$k\t $v"}
if {$ext != {}} {
if {[info exists xref($ext,$word)]} {
return [XrefLink $xref($ext,$word) $word]
}
}
if {[info exists xref($word)]} {
return [XrefLink $xref($word) $word]
}
return $word
}
proc XrefList {list {ext {}}} {
XrefInit
set res [list]
foreach w $list {lappend res [XrefMatch $w $ext]}
return $res
}
proc XrefLink {dest label} {
# Ensure that the link is properly done relative to this file!
set save $dest
#puts_stderr "XrefLink $dest $label"
set here [file split [dt_fmap [dt_file]]]
set dest [file split $dest]
#puts_stderr "XrefLink < $here"
#puts_stderr "XrefLink > $dest"
while {[string equal [lindex $dest 0] [lindex $here 0]]} {
set dest [lrange $dest 1 end]
set here [lrange $here 1 end]
if {[llength $dest] == 0} {break}
}
set ul [llength $dest]
set hl [llength $here]
if {$ul == 0} {
set dest [lindex [file split $save] end]
} else {
while {$hl > 1} {
set dest [linsert $dest 0 ..]
incr hl -1
}
set dest [eval file join $dest]
}
#puts_stderr "XrefLink --> $dest"
return "[markup ""] $label [markup ]" ; # "
}