diff options
Diffstat (limited to 'tcllib/modules/doctools2toc/export_html.tcl')
-rw-r--r-- | tcllib/modules/doctools2toc/export_html.tcl | 323 |
1 files changed, 323 insertions, 0 deletions
diff --git a/tcllib/modules/doctools2toc/export_html.tcl b/tcllib/modules/doctools2toc/export_html.tcl new file mode 100644 index 0000000..bfdbeed --- /dev/null +++ b/tcllib/modules/doctools2toc/export_html.tcl @@ -0,0 +1,323 @@ +# text.tcl -- +# +# The HTML export plugin. Generation of HTML markup. +# +# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: export_html.tcl,v 1.3 2009/11/15 05:50:03 andreas_kupries Exp $ + +# This package is a plugin for the doctools::toc v2 system. It takes +# the list serialization of a table of contents and produces text in +# HTML format. + +# ### ### ### ######### ######### ######### +## Requisites + +# @mdgen NODEP: doctools::toc::export::plugin + +package require Tcl 8.4 +package require doctools::toc::export::plugin ; # Presence of this + # pseudo package + # indicates execution + # inside of a properly + # initialized plugin + # interpreter. +package require doctools::toc::structure ; # Verification that the + # input is proper. +package require doctools::html +package require doctools::html::cssdefaults + +doctools::html::import ;# -> ::html::* + +# ### ### ### ######### ######### ######### +## API. + +proc export {serial configuration} { + + # Phase I. Check that we got a canonical toc serialization. That + # makes the unpacking easier, as we can mix it with the + # generation of the output, knowing that everything is + # already sorted as it should be. + + ::doctools::toc::structure verify-as-canonical $serial + + # ### ### ### ######### ######### ######### + # Configuration ... + # * Standard entries + # - user = person running the application doing the formatting + # - format = name of this format + # - file = name of the file the toc came from. Optional. + # - map = maps symbolic references to actual file path. Optional. + + # * HTML specific entries + # - newlines = boolean. tags separated by eol markers + # - indented = boolean. tags indented per their nesting structure. + # //layout = string in { list, table }. + # + # - meta = HTML fragment for use within the document <meta> section. + # - header = HTML fragment used immediately after <body> + # - footer = HTML fragment used immediately before </body> + # + # - rid = dictionary mapping element labels to link anchor names. + # <=> Reference IDentifier + # + # Notes + # * indented => newlines + + # Import the configuration and initialize the internal state + #// layout list + array set config { + newlines 0 + indented 0 + meta {} + header {} + footer {} + rid {} + map {} + sepline ------------------------------------------------------------ + class.main doctools + class.header toc-header + class.title toc-title + class.navsep toc-navsep + class.contents toc-contents + class.ref toc-ref + class.div toc-div + class.footer toc-footer + } + array set config $configuration + array set map $config(map) + array set rid $config(rid) + + # Force the implications mentioned in the notes above. + if {$config(indented)} { + set config(newlines) 1 + } + + # Allow structuring comments iff structure is present. + set config(comments) [expr {$config(indented) || $config(newlines)}] + + # ### ### ### ######### ######### ######### + + # Phase II. Generate the output, taking the configuration into + # account. + + # Unpack the serialization. + array set toc $serial + array set toc $toc(doctools::toc) + unset toc(doctools::toc) + + html::begin + # Configure the layouting + if {!$config(indented)} { html::indenting 0 } + if {!$config(newlines)} { html::newlines 0 } + + html::tag* html { + html::newline ; html::indented 4 { + Header + Provenance + Body + } + } + + return [html::done] +} + +# ### ### ### ######### ######### ######### + +proc Header {} { + upvar 1 config config toc toc + html::tag* head { + html::newline ; html::indented 4 { + html::tag= title [Title] ; html::newline + if {![Extend meta]} { + html::tag* style { + DefaultStyle + } ; html::newline + } + } + } ; html::newline + return +} + +proc Provenance {} { + upvar 1 config config + if {!$config(comments)} return + html::comment [html::collect { + html::indented 4 { + html::+ "Generated @ [clock format [clock seconds]]" ; html::newline + html::+ "By $config(user)" ; html::newline + if {[info exists config(file)] && ($config(file) ne {})} { + html::+ "From file $config(file)" ; html::newline + } + } + }] ; html::newline + return +} + +proc Body {} { + upvar 1 config config rid rid toc toc + html::tag* body { + html::newline ; html::indented 4 { + html::tag* div class $config(class.main) { + html::newline ; html::indented 4 { + html::tag* div class $config(class.header) { + html::newline ; html::indented 4 { + BodyTitle + UserHeader + html::tag1 hr class $config(class.navsep) ; html::newline + } + } ; html::newline + Division $toc(items) {} {Table Of Contents} + html::tag* div class $config(class.footer) { + html::newline ; html::indented 4 { + html::tag1 hr class $config(class.navsep) ; html::newline + UserFooter + } + } ; html::newline + } + } ; html::newline + } + } ; html::newline + return +} + +# ### ### ### ######### ######### ######### + +proc BodyTitle {} { + upvar 1 toc toc config config + html::tag= h1 class $config(class.title) [Title] ; html::newline + return +} + +proc UserHeader {} { + upvar 1 config config + Extend header + html::newline + return +} + +proc UserFooter {} { + upvar 1 config config + Extend footer + html::newline + return +} + +# ### ### ### ######### ######### ######### + +proc Title {} { + upvar 1 toc(label) label toc(title) title + if {($label ne {}) && ($title ne {})} { + return "$label -- $title" + } elseif {$label ne {}} { + return $label + } elseif {$title ne {}} { + return $title + } + return -code error {Reached the unreachable} +} + +proc DefaultStyle {} { + html::comment \n[doctools::html::cssdefaults::contents] + return +} + +# ### ### ### ######### ######### ######### + +proc Division {items path seplabel} { + upvar 1 config config rid rid map map + + # No content for an empty division + if {![llength $items]} return + + # Process the elements in a division. + + Separator "Start $seplabel" + + html::tag* dl class $config(class.contents) { + html::newline ; html::indented 4 { + foreach element $items { + foreach {etype edata} $element break + array set e $edata + switch -exact -- $etype { + reference { + html::tag* dt class $config(class.ref) { + RMap $e(label) + html::tag= a href [Map $e(id)] $e(label) + } + html::newline + html::tag= dd class $config(class.ref) $e(desc) + html::newline + } + division { + html::tag* dt class $config(class.div) { + RMap $e(label) + if {[info exists e(id)]} { + html::tag= a href [Map $e(id)] $e(label) + } else { + html::+ $e(label) + } + } + html::newline + html::tag* dd class $config(class.div) { + html::newline ; html::indented 4 { + Division $e(items) [linsert $path end $e(label)] "Division ($e(label))" + } + } ; html::newline + } + } + unset e + } + } + } ; html::newline + Separator "Stop $seplabel" +} + +# ### ### ### ######### ######### ######### + +proc Separator {{text {}}} { + upvar config config + if {!$config(comments)} return + set str $config(sepline) + if {$text ne {}} { + set new " $text " + set str [string replace $str 1 [string length $new] $new] + } + html::comment $str + html::newline + return +} + +proc Map {id} { + upvar 1 map map + if {![info exists map($id)]} { return $id } + return $map($id) +} + +proc RMap {label} { + upvar 1 rid rid path path + set k [linsert $path end $label] + if {![info exists rid($k)]} return + html::tag/ a name $rid($k) +} + +proc Extend {varname} { + upvar 1 config config + if {$config($varname) eq {}} { + if {$config(comments)} { + html::comment "Customization Point: $varname" + } + return 0 + } + html::+++ $config($varname) + return 1 +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide doctools::toc::export::html 0.1 +return |