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 {·} 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 {·} 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