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