# -*- tcl -*- # # fmt.html # # Copyright (c) 2001-2008 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 {} {return "[markup "&"]copy;"} proc bgcolor {} {return ""} proc border {} {return 0} proc Year {} {clock format [clock seconds] -format %Y} c_holdBuffers require synopsis ################################################################ ## 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 set liststack {} proc lpush {t class} { global liststack lappend liststack [list [tag/ $t] [litc_getandclear]] return [taga $t [list class $class]] } proc lpop {} { global liststack set t [lindex $liststack end] set liststack [lreplace $liststack end end] foreach {t l} $t break litc_set $l return $t } proc fmt_plain_text {text} { return $text } ################################################################ # Formatting commands. c_pass 1 fmt_manpage_begin {title section version} {c_cinit ; c_clrSections ; return} c_pass 2 fmt_manpage_begin {title section version} { global sec_is_open ; set sec_is_open 0 global subsec_is_open ; set subsec_is_open 0 global prev_litem_close ; set prev_litem_close {} global para_is_open ; set para_is_open 0 global liststack ; set liststack {} global defaultstyle XrefInit c_cinit set module [dt_module] set shortdesc [c_get_module] set description [c_get_title] set copyright [c_get_copyright] set hdr "" if {![Get raw]} { append hdr [tag html] [tag head] \n append hdr [tag_ title "$title - $shortdesc"] \n if {![Extend hdr ByParameter meta]} { # Insert standard CSS definitions. append hdr [tag_ style \ "[markup <]!--${defaultstyle}--[markup >]" \ type text/css] \n } append hdr [tag/ head] \n append hdr [ht_comment [c_provenance]]\n if {$copyright != {}} { append hdr [ht_comment $copyright]\n } append hdr [ht_comment "CVS: \$Id\$ $title.$section"] append hdr \n\n append hdr [tag body] } append hdr [tag* div class doctools] \n Extend hdr ByParameter header set thetitle "[string trimleft $title :]($section) $version $module \"$shortdesc\"" append hdr [tag_ h1 $thetitle class title] \n append hdr [fmt_section Name name] \n append hdr "[para_open] $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 ca [c_xref_category] set ct [c_get_copyright] if {[llength $sa] > 0} { append res [fmt_section {See Also} see-also] \n append res [join [XrefList [lsort $sa] sa] ", "] \n } if {[llength $kw] > 0} { append res [fmt_section Keywords keywords] \n append res [join [XrefList [lsort $kw] kw] ", "] \n } if {$ca ne ""} { append res [fmt_section Category category] \n append res $ca \n } if {$ct != {}} { append res [fmt_section Copyright copyright] \n append res [join [split $ct \n] [tag br]\n] [tag br]\n } # Close last paragraph, subsection, and section. append res [para_close][subsec_close][sec_close] Extend res ByParameter footer append res [tag/ div] if {![Get raw]} { append res [tag/ body] [tag/ html] } return $res } c_pass 1 fmt_section {name id} {c_newSection $name 1 end $id} c_pass 2 fmt_section {name id} { return "[sec_open $id][tag_ h2 [anchor $id $name]]\n[para_open]" } c_pass 1 fmt_subsection {name id} {c_newSection $name 2 end $id} c_pass 2 fmt_subsection {name id} { return "[subsec_open $id][tag_ h3 [anchor $id $name]]\n[para_open]" } # Para breaks inside and outside of lists are identical proc fmt_nl {} {para_open} proc fmt_para {} {para_open} c_pass 2 fmt_require {pkg {version {}}} NOP c_pass 1 fmt_require {pkg {version {}}} { if {$version != {}} { append pkg " " $version } c_hold require [tag_ li "package require [bold $pkg pkgname]"] return } c_pass 2 fmt_usage {cmd args} NOP c_pass 1 fmt_usage {cmd args} { if {[llength $args]} { set text "$cmd [join $args " "]" } else { set text $cmd } c_hold synopsis [tag_ li $text] return } c_pass 1 fmt_call {cmd args} { if {[llength $args]} { set text "$cmd [join $args " "]" } else { set text $cmd } c_hold synopsis [tag_ li [link $text "#[c_cnext]"]] return } c_pass 2 fmt_call {cmd args} { if {[llength $args]} { set text "$cmd [join $args " "]" } else { set text $cmd } return [fmt_lst_item [anchor [c_cnext] $text]] } c_pass 1 fmt_description {did} NOP c_pass 2 fmt_description {did} { set result "" set syn [c_held synopsis] set req [c_held require] # Create the TOC. # Pass 1: We have a number of special sections which were not # listed explicitly in the document sources. Add them # now. Note the inverse order for the sections added # at the beginning. c_newSection Description 1 0 $did if {$syn != {} || $req != {}} {c_newSection Synopsis 1 0 synopsis} c_newSection {Table Of Contents} 1 0 toc if {[llength [c_xref_seealso]] > 0} {c_newSection {See Also} 1 end see-also} if {[llength [c_xref_keywords]] > 0} {c_newSection Keywords 1 end keywords} if {[c_xref_category] ne ""} {c_newSection Category 1 end category} if {[c_get_copyright] != {}} {c_newSection Copyright 1 end copyright} set sections $::SectionList # Pass 2: Generate the markup for the TOC, indenting the # links according to the level of each section. append result [fmt_section {Table Of Contents} toc] [para_close] \n append result [taga ul {class toc}] \n set lastlevel 1 set close 0 foreach {name id level} $sections { # level in {1,2}, 1 = sectio n, 2 = subsection if {$level == $lastlevel} { # Close previous item. if {$close} { append result [tag/ li] \n } } elseif {$level > $lastlevel} { # Start list of subsections append result \n [tag ul] \n } else { # level < lastlevel # End list of subsections, and of previous item (two # actually, the subsection, and the section item). append result [tag/ li] \n [tag/ ul] \n [tag/ li] \n } # Start entry if {$level == 1} { append result [taga li {class section}] [link $name "#$id"] } else { append result [taga li {class subsection}] [link $name "#$id"] } set close 1 set lastlevel $level } if {$lastlevel > 1 } { append result [tag/ ul] \n } if {$close} { append result [tag/ li] \n } append result [tag/ ul] \n # Implicit sections coming after the TOC (Synopsis, then the # description which starts the actual document). The other # implict sections are added at the end of the document and # are generated by 'fmt_manpage_end' in the second pass. if {$syn != {} || $req != {}} { append result [fmt_section Synopsis synopsis] [para_close] [taga div {class synopsis}] \n if {$req != {}} { append result [tag_ ul \n$req\n class requirements] \n } if {$syn != {}} { append result [tag_ ul \n$syn\n class syntax] \n } append result [tag/ div] \n } append result [fmt_section Description $did] \n return $result } ################################################################ proc fmt_list_begin {what {hint {}}} { # NOTE: The hint is ignored. Use stylesheet definitions to modify # item and general list spacing. switch -exact -- $what { enumerated {set tag ol} itemized {set tag ul} arguments - commands - options - tkoptions - definitions {set tag dl} } return [para_close][lpush $tag $what] } proc fmt_list_end {} { set res [para_close][litc_getandclear]\n[lpop][para_open] return $res } proc fmt_lst_item {text} { set res [para_close][litc_getandclear]\n[tag_ dt $text]\n[tag dd][para_open] litc_set [tag/ dd] return $res } proc fmt_bullet {} { set res [para_close][litc_getandclear]\n[tag li][para_open] litc_set [tag/ li] return $res } proc fmt_enum {} { set res [para_close][litc_getandclear]\n[tag li][para_open] litc_set [tag/ li] return $res } proc fmt_cmd_def {command} { fmt_lst_item [fmt_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][tag br]\n" append text "Database Name:\t[bold $dbname optdbname][tag br]\n" append text "Database Class:\t[bold $dbclass optdbclass][tag br]\n" fmt_lst_item $text } ################################################################ proc fmt_example_begin {} { return [para_close]\n[tag* pre class example] } proc fmt_example_end {} { return [tag/ pre]\n[para_open] } proc fmt_example {code} { return "[fmt_example_begin][fmt_plain_text $code][fmt_example_end]" } ################################################################ proc fmt_arg {text} { italic $text arg } proc fmt_cmd {text} { bold [XrefMatch $text sa] cmd } proc fmt_emph {text} { em $text } proc fmt_opt {text} { span "?$text?" opt } proc fmt_comment {text} {ht_comment $text} proc fmt_sectref {title {id {}}} { global SectionNames if {$id == {}} { set id [c_sectionId $title] } if {[info exists SectionNames($id)]} { return [span [link $title "#$id"] sectref] } else { return [bold $title sectref] } } proc fmt_syscmd {text} {bold [XrefMatch $text sa] syscmd} proc fmt_method {text} {bold $text method} proc fmt_option {text} {bold $text option} proc fmt_widget {text} {bold $text widget} proc fmt_fun {text} {bold $text function} proc fmt_type {text} {bold $text type} proc fmt_package {text} {bold [XrefMatch $text sa kw] package} proc fmt_class {text} {bold $text class} proc fmt_var {text} {bold $text variable} proc fmt_file {text} {return "\"[bold $text file]\""} proc fmt_namespace {text} {bold $text namespace} proc fmt_uri {text {label {}}} { if {$label == {}} {set label $text} return [link $label $text] } proc fmt_image {text {label {}}} { # text = symbolic name of the image. set img [dt_imgdst $text {png gif jpg}] if {$label eq {}} { set label $text } if {$img ne {}} { return [imagelink $label [LinkTo $img [LinkHere]]] } if {[regexp -- {^http://} $text] || [regexp -- {^ftp://} $text]} { return [imagelink $label $text] } #puts_stderr here:\t[LinkHere] #puts_stderr dest:\t$img #puts_stderr rela:\t[LinkTo $img [LinkHere]] #puts_stderr return [strong "Image: $label"] } proc fmt_term {text} {italic [XrefMatch $text kw sa] term} proc fmt_const {text} {bold $text const} proc fmt_mdash {} { return "[markup &]mdash;" } proc fmt_ndash {} { return "[markup &]ndash;" } ################################################################ global sec_is_open set sec_is_open 0 proc sec_open {id} { global sec_is_open set res [para_close][subsec_close][sec_close][tag* div id $id class section] set sec_is_open 1 return $res } proc sec_close {} { global sec_is_open if {!$sec_is_open} {return ""} set sec_is_open 0 return [tag/ div]\n } ################################################################ global subsec_is_open set subsec_is_open 0 proc subsec_open {id} { global subsec_is_open set res [para_close][subsec_close][tag* div id $id class subsection] set subsec_is_open 1 return $res } proc subsec_close {} { global subsec_is_open if {!$subsec_is_open} {return ""} set subsec_is_open 0 return [tag/ div]\n } ################################################################ # Piece of html to close the previous list element, if any. # Saved on the list stack global prev_litem_close set prev_litem_close {} proc litc_getandclear {} { global prev_litem_close set res $prev_litem_close set prev_litem_close {} return $res } proc litc_set {value} { global prev_litem_close set prev_litem_close $value return } ################################################################ global para_is_open set para_is_open 0 proc para_open {} { global para_is_open set res [para_close][tag p] set para_is_open 1 return $res } proc para_close {} { global para_is_open if {!$para_is_open} {return ""} set para_is_open 0 return [tag/ p] } ################################################################ global xref ; array set xref {} global __var array set __var { meta {} header {} footer {} xref {} raw 0 } 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 } # Engine parameter handling proc Extend {v _ by} { set html [Get $by] if {$html == {}} { return 0 } upvar 1 $v text append text [markup $html] \n return 1 } global defaultstyle set defaultstyle { HTML { background: #FFFFFF; color: black; } BODY { background: #FFFFFF; color: black; } DIV.doctools { margin-left: 10%; margin-right: 10%; } DIV.doctools H1,DIV.doctools H2 { margin-left: -5%; } H1, H2, H3, H4 { margin-top: 1em; font-family: sans-serif; font-size: large; color: #005A9C; background: transparent; text-align: left; } H1.title { text-align: center; } UL,OL { margin-right: 0em; margin-top: 3pt; margin-bottom: 3pt; } UL LI { list-style: disc; } OL LI { list-style: decimal; } DT { padding-top: 1ex; } UL.toc,UL.toc UL, UL.toc UL UL { font: normal 12pt/14pt sans-serif; list-style: none; } LI.section, LI.subsection { list-style: none; margin-left: 0em; text-indent: 0em; padding: 0em; } PRE { display: block; font-family: monospace; white-space: pre; margin: 0%; padding-top: 0.5ex; padding-bottom: 0.5ex; padding-left: 1ex; padding-right: 1ex; width: 100%; } PRE.example { color: black; background: #f5dcb3; border: 1px solid black; } UL.requirements LI, UL.syntax LI { list-style: none; margin-left: 0em; text-indent: 0em; padding: 0em; } DIV.synopsis { color: black; background: #80ffff; border: 1px solid black; font-family: serif; margin-top: 1em; margin-bottom: 1em; } UL.syntax { margin-top: 1em; border-top: 1px solid black; } UL.requirements { margin-bottom: 1em; border-bottom: 1px solid black; } } ################################################################ 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 args} { global xref foreach ext $args { if {$ext != {}} { if {[info exists xref($ext,$word)]} { return [XrefLink $xref($ext,$word) $word] } } } if {[info exists xref($word)]} { return [XrefLink $xref($word) $word] } # Convert the word to all-lower case and then try again. set lword [string tolower $word] foreach ext $args { if {$ext != {}} { if {[info exists xref($ext,$lword)]} { return [XrefLink $xref($ext,$lword) $word] } } } if {[info exists xref($lword)]} { return [XrefLink $xref($lword) $word] } return $word } proc XrefList {list {ext {}}} { set res [list] foreach w $list {lappend res [XrefMatch $w $ext]} return $res } proc LinkHere {} { return [dt_fmap [dt_mainfile]] } proc LinkTo {dest here} { # Ensure that the link is properly done relative to this file! set save $dest #puts_stderr "XrefLink $dest $label" set here [file split $here] 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 $dest } proc XrefLink {dest label} { # Ensure that the link is properly done relative to this file! set here [LinkHere] set dest [LinkTo $dest $here] if {[string equal $dest [lindex [file split $here] end]]} { # Suppress self-referential links, i.e. links made from the # current file to itself. Note that links to specific parts of # the current file are not suppressed, only exact links. return $label } return [link $label $dest] }