# -*- tcl -*- # # fmt.html # # Copyright (c) 2001-2003 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. # ################################################################ ################################################################ dt_source _common.tcl ; # Shared code dt_source _html.tcl ; # HTML basic formatting 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 ]$title - $shortdesc [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

] [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 copyright [c_get_copyright] if {$copyright != {}} { append res [fmt_section COPYRIGHT] \n append res [join [split $copyright \n] [tag br]\n] [tag br]\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

]" } 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_see_also {args} {return "[fmt_section {SEE ALSO}]\n[join $args ", "]"} proc fmt_keywords {args} {return "[fmt_section KEYWORDS]\n[join $args ", "]"} 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 ""]$text[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 $text} 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 $text} proc fmt_const {text} {strong $text} ################################################################