# -*- tcl -*- # # fmt.html # # (c) 2001 Andreas Kupries # # [expand] definitions to convert a tcl based manpage definition into # a manpage based upon HTML markup. Additional definition files allow # the conversion into nroff and TMML. # ################################################################ ################################################################ proc here {} [list return [__file dirname [info script]]] proc this {} [list return [__file tail [info script]]] source [__file join [here] _common.tcl] ; # Shared code source [__file join [here] _html.tcl] ; # HTML basic formatting proc bgcolor {} {return ""} proc border {} {return 0} ################################################################ ################################################################ ## Backend for HTML markup # ============================================================== # Internal data structures and state # -------------------------------------------------------------- # I. Internal cross references (between and to sections) global SectionNames ;# array mapping section name to refid # sectionId -- # Format section name as an XML ID. # proc sectionId {name} { regsub -all {[^[:alnum:]]} $name {} name return [string tolower $name] } # possibleReference text gi -- # Check if $text is a potential cross-reference; # if so, format as a reference; # otherwise format as a $gi element. # proc 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] } } # -------------------------------------------------------------- # II. Description tracking: Located in the common code. # -------------------------------------------------------------- # III. 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 HandleText {text} { set redux [string map [list " " "" "\t" "" "\n" ""] $text] if {$redux != {}} {lsmark 0} return [htmlEscape $text] } ################################################################ ################################################################ ################################################################ # Formatting commands. proc manpage_begin {title section version} { if {[mp_pass] == 1} {return} set module [mp_module] set shortdesc [GetDesc mdesc] set description [GetDesc tdesc] set hdr "" append hdr "[markup ]$title - $shortdesc [markup ]\n" append hdr "[ht_comment "Generated from [mp_file] by tcllib/doctools/mpexpand with [this]"]\n" append hdr "[ht_comment "Copyright (c) [clock format [clock seconds] -format %Y] $::tcl_platform(user)"]\n" append hdr "[ht_comment {All rights reserved}]\n" append hdr "[ht_comment "CVS: \$Id\$ $title.$section"]\n" append hdr "\n" append hdr "[markup

] [string trimleft $title :]($section) $version $module \"$shortdesc\"[markup

]\n" append hdr "[section NAME]\n" append hdr "[para] $title - $description" return $hdr } proc moddesc {desc} { if {[mp_pass] == 2} {return} SetDesc mdesc $desc return } proc titledesc {desc} { if {[mp_pass] == 2} {return} SetDesc tdesc $desc return } proc manpage_end {} {return [markup ]} proc section {name} { set ::SectionNames($name) [set id [sectionId $name]] return "[markup <]a name=[markup \"]$id[markup \">

]$name[markup

]" } proc para {} {return [markup

]} proc require {pkg {version {}}} { Req 1 set result "[x_synopsis]package require [markup ]$pkg" if {$version != {}} { append result " $version" } append result [markup "
"] return $result } proc usage {cmd args} { if {[mp_pass] == 1} { AddCall "[trtop][td]$cmd [join $args " "][markup ]\n" return } return "" } proc call {cmd args} { if {[mp_pass] == 1} { AddCall "[trtop][td]$cmd [join $args " "][markup ]\n" return } return "[lst_item "$cmd [join $args " "]"]\n" } proc description {} { set result "" if {[GetCall] != {}} { append result [x_synopsis] if {[Req]} {append result [markup
]} proc bgcolor {} {return lightyellow} append result [btable][tr][td][table][GetCall][markup ]\n proc bgcolor {} {return ""} } append result [section DESCRIPTION] return $result } proc x_synopsis {} { if {![Syn]} { return [section SYNOPSIS]\n } else { return "" } } ################################################################ proc list_begin {what {hint {}}} { switch -exact -- $what { enum {set tag ol} bullet {set tag ul} arg - cmd - opt - tkoption - definitions {set tag dl} default {return -code error "Unknown list type $what"} } return [if {[llevel]} {limark} else {}][lpush $tag $hint][lsmark 1] } proc list_end {} {return [lpop][lsmark 1]} proc lst_item {text} {return [limark][tag dt]$text[tag dd][lsmark 1]} proc bullet {} {return [limark][tag li][lsmark 1]} proc enum {} {return [limark][tag li][lsmark 1]} proc arg_def {type name {mode {}}} { set text "" append text "$type [arg $name]" if {$mode != {}} { append text " ($mode)" } lst_item $text } proc cmd_def {command} { lst_item [cmd $command] } proc opt_def {name {arg {}}} { set text [option $name] if {$arg != {}} {append text " $arg"} lst_item $text } proc tkoption_def {name dbname dbclass} { set text "" append text "Command-Line Switch:\t[option $name][markup
]\n" append text "Database Name:\t[strong $dbname][markup
]\n" append text "Database Class:\t[strong $dbclass][markup
]\n" lst_item $text } ################################################################ proc see_also {args} {return "[section {SEE ALSO}]\n[join $args ", "]"} proc keywords {args} {return "[section KEYWORDS]\n[join $args ", "]"} proc example_begin {} { lsmark 0 return [markup "

 
"]
}
proc example_end   {} {
    return [markup "

"] } proc example {code} { return "[example_begin][HandleText $code][example_end]" } proc nl {} { if {[lcompact]} {return [tag br]} return [tag br][tag br] } proc arg {text} {return "[markup ""]$text[markup ]" } proc cmd {text} {return "[markup ""]$text[markup ]" } proc emph {text} { possibleReference $text em } proc strong {text} { possibleReference $text strong } proc opt {text} {return "?$text?" } proc comment {text} {ht_comment $text} proc 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 syscmd {text} {strong $text} proc method {text} {strong $text} proc option {text} {strong $text} proc widget {text} {strong $text} proc fun {text} {strong $text} proc type {text} {strong $text} proc package {text} {strong $text} proc class {text} {strong $text} proc var {text} {strong $text} proc file {text} {return "\"[strong $text]\""} proc uri {text} {return "[markup <]a href=[markup \"]$text[markup \">]$text[markup ]"} proc term {text} {emph $text} proc const {text} {strong $text} ################################################################ # HTML specific commands ################################################################ proc setx {v string} { upvar $v _ set _ $string return } proc appendx {v string} { upvar $v _ append _ $string return } ################################################################