1# doctoc.tcl --
2#
3#	The doctoc export plugin. Generation of doctoc 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_doctoc.tcl,v 1.3 2009/11/15 05:50:03 andreas_kupries Exp $
11
12# This package is a plugin for the doctools::toc v2 system.  It takes
13# the list serialization of a table of contens and produces text in
14# doctoc format.
15
16# ### ### ### ######### ######### #########
17## Requisites
18
19# @mdgen NODEP: doctools::toc::export::plugin
20
21package require Tcl 8.4
22package require doctools::toc::export::plugin ; # Presence of this
23						# pseudo package
24						# indicates execution
25						# inside of a properly
26						# initialized plugin
27						# interpreter.
28package require doctools::toc::structure      ; # Verification that
29						# the input is proper.
30
31# ### ### ### ######### ######### #########
32## API.
33
34proc export {serial configuration} {
35
36    # Phase I. Check that we got a canonical ToC serialization. That
37    #          makes the unpacking easier, as we can mix it with the
38    #          generation of the output, knowing that everything is
39    #          already sorted as it should be.
40
41    ::doctools::toc::structure verify-as-canonical $serial
42
43    # ### ### ### ######### ######### #########
44    # Configuration ...
45    # * Standard entries
46    #   - user   = person running the application doing the formatting
47    #   - format = name of this format
48    #   - file   = name of the file the ToC came from. Optional.
49    #   - map    = maps symbolic document ids to actual file path or url. Optional.
50    # * doctoc specific entries
51    #   - newlines = boolean. tags separated by eol markers
52    #   - indented = boolean. tags indented per the toc structure.
53    #   - aligned  = boolean. reference information tabular aligned within keys.
54    #
55    # Notes
56    # * This format ignores 'map' even if set, as the written doctoc
57    #   contains the symbolic document ids and only them.
58    # * aligned  => newlines
59    # * indented => newlines
60
61    # Combinations of the format specific entries
62    # N I A |
63    # - - - + ---------------------
64    # 0 0 0 | Ultracompact (no whitespace, single line)
65    # 1 0 0 | Compact (no whitespace, multiple lines)
66    # 1 1 0 | Indented
67    # 1 0 1 | Tabular aligned references
68    # 1 1 1 | Indented + Tabular aligned references
69    # - - - + ---------------------
70    # 0 1 0 | Not possible, per the implications above.
71    # 0 0 1 | ditto
72    # 0 1 1 | ditto
73    # - - - + ---------------------
74
75    # Import the configuration and initialize the internal state
76    array set config {
77	newlines 0
78	aligned  0
79	indented 0
80    }
81    array set config $configuration
82
83    # Force the implications mentioned in the notes above.
84    if {
85	$config(aligned) ||
86	$config(indented)
87    } {
88	set config(newlines) 1
89    }
90
91    # ### ### ### ######### ######### #########
92
93    # Phase II. Generate the output, taking the configuration into
94    #           account.
95
96    TagsBegin
97
98    # First some comments about the provenance of the output.
99    Tag+ comment [list "Generated @ [clock format [clock seconds]]"]
100    Tag+ comment [list "By          $config(user)"]
101    if {[info exists config(file)] && ($config(file) ne {})} {
102	Tag+ comment [list "From file   $config(file)"]
103    }
104
105    # Unpack the serialization.
106    array set toc $serial
107    array set toc $toc(doctools::toc)
108    unset     toc(doctools::toc)
109
110    # Now open the markup
111
112    Tag+ toc_begin [list $toc(label) $toc(title)]
113    PrintItems $toc(items) {    } {    }
114    TagPrefix {}
115    Tag+ toc_end
116
117    # Last formatting, joining the commands together.
118    set sep [expr {$config(newlines) ? "\n" : ""}]
119    return [join $lines $sep]
120
121    # ### ### ### ######### ######### #########
122}
123
124# ### ### ### ######### ######### #########
125
126proc PrintItems {items indentation increment} {
127    upvar 1 config config prefix prefix lines lines
128
129    if {$config(aligned)} {
130	set imax 0
131	set lmax 0
132	foreach element $items {
133	    foreach {etype edata} $element break
134	    if {$etype eq "division"} { continue }
135	    array set toc $edata
136	    Max imax [list $toc(id)]
137	    Max lmax [list $toc(label)]
138	    unset toc
139	}
140    }
141
142    foreach element $items {
143	if {$config(indented)} {TagPrefix $indentation}
144	foreach {etype edata} $element break
145	array set toc $edata
146	switch -exact -- $etype {
147	    reference {
148		if {$config(aligned)} {
149		    Tag+ item [FmtR imax $toc(id)] [FmtR lmax $toc(label)] [list $toc(desc)]
150		} else {
151		    Tag+ item [list $toc(id) $toc(label) $toc(desc)]
152		}
153	    }
154	    division {
155		if {[info exists toc(id)]} {
156		    Tag+ division_start [list $toc(label) $toc(id)]
157		} else {
158		    Tag+ division_start [list $toc(label)]
159		}
160		PrintItems $toc(items) $indentation$increment $increment
161		if {$config(indented)} {TagPrefix $indentation}
162		Tag+ division_end
163	    }
164	}
165	unset toc
166    }
167    return
168}
169
170# ### ### ### ######### ######### #########
171
172proc TagPrefix {str} {
173    upvar 1 prefix prefix
174    set    prefix $str
175    return
176}
177
178proc TagsBegin {} {
179    upvar 1 prefix prefix lines lines
180    set prefix {}
181    set lines  {}
182    return
183}
184
185proc Tag {n args} {
186    upvar 1 prefix prefix
187    set    cmd $prefix
188    append cmd \[$n
189    if {[llength $args]} { append cmd " [join $args]" }
190    append  cmd \]
191    return $cmd
192}
193
194proc Tag+ {n args} {
195    upvar 1 prefix prefix lines lines
196    lappend lines [eval [linsert $args 0 Tag $n]]
197    return
198}
199
200proc Max {v str} {
201    upvar 1 $v max
202    set x [string length $str]
203    if {$x <= $max} return
204    set max $x
205    return
206}
207
208proc FmtR {v str} {
209    upvar 1 $v max
210    return [list $str][string repeat { } [expr {$max - [string length [list $str]]}]]
211}
212
213# ### ### ### ######### ######### #########
214## Ready
215
216package provide doctools::toc::export::doctoc 0.1
217return
218