1# text.tcl --
2#
3#	The HTML export plugin. Generation of HTML markup.
4#
5# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net>
6#
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id: export_html.tcl,v 1.3 2009/08/07 18:53:11 andreas_kupries Exp $
11
12# This package is a plugin for the doctools::idx v2 system.  It takes
13# the list serialization of a keyword index and produces text in HTML
14# format.
15
16# ### ### ### ######### ######### #########
17## Requisites
18
19# @mdgen NODEP: doctools::idx::export::plugin
20
21package require Tcl 8.4
22package require doctools::idx::export::plugin ; # Presence of this
23						# pseudo package
24						# indicates execution
25						# inside of a properly
26						# initialized plugin
27						# interpreter.
28package require doctools::idx::structure ; # Verification that the
29					   # input is proper.
30package require doctools::html
31package require doctools::html::cssdefaults
32
33doctools::html::import ;# -> ::html::*
34
35# ### ### ### ######### ######### #########
36## API.
37
38proc export {serial configuration} {
39
40    # Phase I. Check that we got a canonical index serialization. That
41    #          makes the unpacking easier, as we can mix it with the
42    #          generation of the output, knowing that everything is
43    #          already sorted as it should be.
44
45    ::doctools::idx::structure verify-as-canonical $serial
46
47    # ### ### ### ######### ######### #########
48    # Configuration ...
49    # * Standard entries
50    #   - user   = person running the application doing the formatting
51    #   - format = name of this format
52    #   - file   = name of the file the index came from. Optional.
53    #   - map    = maps symbolic references to actual file path. Optional.
54
55    # * HTML specific entries
56    #   - newlines = boolean. tags separated by eol markers
57    #   - indented = boolean. tags indented per their nesting structure.
58    #   //layout   = string in { list, table }.
59    #
60    #   - meta   = HTML fragment for use within the document <meta> section.
61    #   - header = HTML fragment used immediately after <body>
62    #   - footer = HTML fragment used immediately before </body>
63    #
64    #   - kwid   = dictionary mapping keywords to link anchor names.
65    #     <=> KeyWord IDentifier
66    #
67    # Notes
68    # * indented => newlines
69
70    # Import the configuration and initialize the internal state
71    #// layout    list
72    array set config {
73	newlines  0
74	indented  0
75	meta      {}
76	header    {}
77	footer    {}
78	kwid      {}
79	map       {}
80	sepline   ------------------------------------------------------------
81	kwidth         35
82	dot            {&#183;}
83	class.main     doctools
84	class.header   idx-header
85	class.title    idx-title
86	class.navsep   idx-navsep
87	class.navbar   idx-kwnav
88	class.contents idx-contents
89	class.leader   idx-leader
90	class.row0     idx-even
91	class.row1     idx-odd
92	class.keyword  idx-keyword
93	class.refs     idx-refs
94	class.footer   idx-footer
95    }
96    array set config $configuration
97    array set map    $config(map)
98    array set kwid   $config(kwid)
99
100    if {($config(kwidth) < 1) || ($config(kwidth) > 99)} {
101	set config(kwidth) 35
102    }
103    set config(rwidth) [expr {100 - $config(kwidth)}]
104
105
106    # Force the implications mentioned in the notes above.
107    if {$config(indented)} {
108	set config(newlines) 1
109    }
110
111    # Allow structuring comments iff structure is present.
112    set config(comments) [expr {$config(indented) || $config(newlines)}]
113
114    array set anchor {}
115    set dot {&#183;}
116
117    # ### ### ### ######### ######### #########
118
119    # Phase II. Generate the output, taking the configuration into
120    #           account.
121
122    # Unpack the serialization.
123    array set idx $serial
124    array set idx $idx(doctools::idx)
125    unset     idx(doctools::idx)
126    array set r $idx(references)
127    array set k $idx(keywords)
128
129    html::begin
130    # Configure the layouting
131    if {!$config(indented)} { html::indenting 0 }
132    if {!$config(newlines)} { html::newlines  0 }
133
134    html::tag* html {
135	html::newline ; html::indented 4 {
136	    Header
137	    Provenance
138	    Body
139	}
140    }
141
142    return [html::done]
143}
144
145# ### ### ### ######### ######### #########
146
147proc Header {} {
148    upvar 1 config config idx idx
149    html::tag* head {
150	html::newline ; html::indented 4 {
151	    html::tag= title [Title] ; html::newline
152	    if {![Extend meta]} {
153		html::tag* style {
154		    DefaultStyle
155		} ; html::newline
156	    }
157	}
158    } ; html::newline
159    return
160}
161
162proc Provenance {} {
163    upvar 1 config config
164    if {!$config(comments)} return
165    html::comment [html::collect {
166	html::indented 4 {
167	    html::+  "Generated @ [clock format [clock seconds]]" ; html::newline
168	    html::+  "By          $config(user)"                  ; html::newline
169	    if {[info exists config(file)] && ($config(file) ne {})} {
170		html::+ "From file   $config(file)" ; html::newline
171	    }
172	}
173    }] ; html::newline
174    return
175}
176
177proc Body {} {
178    upvar 1 config config idx idx dot dot anchor anchor kwid kwid k k r r
179    html::tag* body {
180	html::newline ; html::indented 4 {
181	    html::tag* div class $config(class.main) {
182		html::newline ; html::indented 4 {
183		    html::tag* div class $config(class.header) {
184			html::newline ; html::indented 4 {
185			    BodyTitle
186			    UserHeader
187			    html::tag1 hr class $config(class.navsep) ; html::newline
188			    NavigationBar
189			}
190		    } ;	html::newline
191		    Keywords
192		    html::tag* div class $config(class.footer) {
193			html::newline ; html::indented 4 {
194			    html::tag1 hr class $config(class.navsep) ; html::newline
195			    UserFooter
196			}
197		    } ; html::newline
198		}
199	    } ; html::newline
200	}
201    } ; html::newline
202    return
203}
204
205# ### ### ### ######### ######### #########
206
207proc BodyTitle {} {
208    upvar 1 idx idx config config
209    html::tag= h1 class $config(class.title) [Title] ; html::newline
210    return
211}
212
213proc UserHeader {} {
214    upvar 1 config config
215    Extend header
216    html::newline
217    return
218}
219
220proc UserFooter {} {
221    upvar 1 config config
222    Extend footer
223    html::newline
224    return
225}
226
227# ### ### ### ######### ######### #########
228
229proc Title {} {
230    upvar 1 idx(label) label idx(title) title
231    if {($label ne {}) && ($title ne {})} {
232	return "$label -- $title"
233    } elseif {$label ne {}} {
234	return $label
235    } elseif {$title ne {}} {
236	return $title
237    }
238    return -code error {Reached the unreachable}
239}
240
241proc DefaultStyle {} {
242    html::comment \n[doctools::html::cssdefaults::contents]
243    return
244}
245
246# ### ### ### ######### ######### #########
247
248proc NavigationBar {} {
249    upvar 1 config config idx idx anchor anchor kwid kwid char char
250
251    # No navigation bar for an empty index.
252
253    if {![llength $idx(keywords)]} return
254
255    # Name each keyword, if that was not done already. And sort them
256    # into bins based on their first character (always taken as upper
257    # case, i.e. X and x are the same).
258
259    foreach {keyword references} $idx(keywords) {
260	if {![info exists kwid($keyword)]} {
261	    set kwid($keyword) KW-$keyword
262	}
263	lappend char([string toupper [string index $keyword 0]]) $keyword
264    }
265
266    # Now name each character
267
268    set counter 0
269    foreach c [lsort -dict [array names char]] {
270	set anchor($c) KEYWORDS-$c
271	incr counter
272    }
273
274    # Now we have the information we can construct the nav bar from.
275
276    # NOTE: Should I do this as ul/ ?  Then the CSS can select the
277    # location of the navbar, its orientation, and how the elements
278    # are joined. Right ?!
279
280    Separator {Navigation Bar}
281    html::newline
282    set sep 0
283    html::tag* div class $config(class.navbar) {
284	html::newline ; html::indented 4 {
285	    foreach c [lsort -dict [array names char]] {
286		if {$sep} {
287		    html::++ " $config(dot)"
288		    if {![html::newline]} { html::++ " " }
289		}
290		html::tag= a href #$anchor($c) $c
291		set sep 1
292	    }
293	    html::newline
294	}
295    } ; html::newline
296    return
297}
298
299proc Keywords {} {
300    upvar 1 config config idx idx anchor anchor dot dot kwid kwid char char k k r r
301
302    # No content for an empty index.
303
304    if {![llength $idx(keywords)]} return
305
306    # Process the characters and associated keywords.
307
308    set rows [list $config(class.row0) $config(class.row1)]
309
310    Separator Contents
311    html::newline
312    html::tag* table class $config(class.contents) width 100% {
313	html::newline ; html::indented 4 {
314	    foreach c [lsort -dict [array names char]] {
315		Separator "($c)"
316		html::newline
317		Leader $c
318		foreach kw $char($c) {
319		    Keyword $kw
320		}
321	    }
322	    Separator
323	    html::newline
324	}
325    } ; html::newline
326    return
327}
328
329proc Leader {char} {
330    upvar 1 anchor anchor config config
331
332    html::tag* tr class $config(class.leader) {
333	html::tag* th colspan 2 {
334	    html::tag= a name $anchor($char) "Keywords: $char"
335	}
336    } ; html::newline
337    return
338}
339
340proc Keyword {kw} {
341    upvar 1 config config rows rows kwid kwid k k r r
342
343    html::tag* tr class [Row] {
344	html::newline ; html::indented 4 {
345	    html::tag* td width $config(kwidth)% class $config(class.keyword) {
346		html::tag= a name $kwid($kw) $kw
347	    } ; html::newline
348	    html::tag* td width $config(rwidth)% class $config(class.refs) {
349		if {[llength $k($kw)]} {
350		    html::newline ; html::indented 4 {
351			References $kw
352		    }
353		}
354	    } ; html::newline
355	}
356    } ; html::newline
357    return
358}
359
360proc References {kw} {
361    upvar 1 config config k k r r
362    # Iterate over the references of the key
363    set sep 0
364    foreach id $k($kw) {
365	foreach {type label} $r($id) break
366	if {$sep} {
367	    html::++ " $config(dot)"
368	    if {![html::newline]} { html::++ " " }
369	}
370	html::tag= a href [Map $type $id] $label
371	set sep 1
372    }
373    html::newline
374    return
375}
376
377# ### ### ### ######### ######### #########
378
379proc Separator {{text {}}} {
380    upvar config config
381    if {!$config(comments)} return
382    set str $config(sepline)
383    if {$text ne {}} {
384	set new " $text "
385	set str [string replace $str 1 [string length $new] $new]
386    }
387    html::comment $str
388    return
389}
390
391proc Row {} {
392    upvar 1 rows rows
393    foreach {a b} $rows break
394    set rows [list $b $a]
395    return $a
396}
397
398proc Map {type id} {
399    if {$type eq "url"} { return $id }
400    upvar 1 map map
401    if {![info exists map($id)]} { return $id }
402    return $map($id)
403}
404
405proc Extend {varname} {
406    upvar 1 config config
407    if {$config($varname) eq {}} {
408	if {$config(comments)} {
409	    html::comment "Customization Point: $varname"
410	}
411	return 0
412    }
413    html::+++ $config($varname)
414    return 1
415}
416
417# ### ### ### ######### ######### #########
418## Ready
419
420package provide doctools::idx::export::html 0.2
421return
422