# -*- tcl -*-
#
# fmt.html
#
# Copyright (c) 2001-2008 Andreas Kupries <[email protected]>
#
# 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 pagetitle "$title - $shortdesc"
set hdr ""
if {![Get raw]} {
append hdr [tag html] [tag head] \n
append hdr [tag_ title $pagetitle] \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 "$title.$section"]
append hdr \n\n
append hdr [tag body]
}
Extend hdr ByParameter header \
@TITLE@ $pagetitle
append hdr [tag* div class doctools] \n
set thetitle "[string trimleft $title :]($section) $version $module \"$shortdesc\""
append hdr [tag_ h1 $thetitle class doctools_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 doctools_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 doctools_section}]
} else {
append result [taga li {class doctools_subsection}]
}
append result [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 doctools_synopsis}] \n
if {$req != {}} {
append result [tag_ ul \n$req\n class doctools_requirements] \n
}
if {$syn != {}} {
append result [tag_ ul \n$syn\n class doctools_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 doctools_$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 doctools_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 doctools_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 doctools_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 args} {
set html [Get $by]
if {$html == {}} { return 0 }
upvar 1 $v text
if {[llength $args]} {
set html [string map $args $html]
}
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.doctools_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.doctools_toc,UL.doctools_toc UL, UL.doctools_toc UL UL {
font: normal 12pt/14pt sans-serif;
list-style: none;
}
LI.doctools_section, LI.doctools_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.doctools_example {
color: black;
background: #f5dcb3;
border: 1px solid black;
}
UL.doctools_requirements LI, UL.doctools_syntax LI {
list-style: none;
margin-left: 0em;
text-indent: 0em;
padding: 0em;
}
DIV.doctools_synopsis {
color: black;
background: #80ffff;
border: 1px solid black;
font-family: serif;
margin-top: 1em;
margin-bottom: 1em;
}
UL.doctools_syntax {
margin-top: 1em;
border-top: 1px solid black;
}
UL.doctools_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]
}
