# -*- 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 ]\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 ]" ; # " }