## -*- tcl -*- # ### ### ### ######### ######### ######### ## # $Id: idx.html,v 1.8 2007/03/20 05:06:35 andreas_kupries Exp $ # # Index Formatting Engine : docidx --> HTML. # Single-pass # # Copyright (c) 2003-2007 Andreas Kupries # Freely redistributable. # ### ### ### ######### ######### ######### ## Requisites dt_source _idx_common.tcl dt_source _html.tcl # ### ### ### ######### ######### ######### ## API implementation rename idx_postprocess {} rename fmt_postprocess idx_postprocess proc fmt_plain_text {text} {return {}} proc fmt_index_begin {l t} { global la ti set la $l set ti $t return {} } proc fmt_key {text} { global key lk ch set lk $text set key($lk) {} set ch([F $lk]) . return {} } proc fmt_manpage {f l} {Ref [dt_fmap $f] $l} proc fmt_url {u l} {Ref $u $l} proc fmt_index_end {} { LoadKwid set lines {} if {![Get raw]} { BeginHeader ; Meta ; EndHeader BeginBody } BodyHeader ; Title ; Navbar BeginIndex ; Keys ; EndIndex if {![Get raw]} { EndBody } return [join $lines \n] } # ### ### ### ######### ######### ######### ## Helper commands proc Ref {r l} { global key lk lappend key($lk) $r $l return {} } proc F {text} { # Keep only alphanumeric, take first, uppercase # Returns nothing if input has no alphanumeric characters. return [string toupper [string index [regsub -all {[^a-zA-Z0-9]} $text {}] 0]] } proc LoadKwid {} { global kwid # Engine parameter - load predefined keyword anchors. set ki [Get kwid] if {![llength $ki]} return array set kwid $ki return } proc BeginHeader {} { global la ti upvar 1 lines lines lappend lines [markup {}] lappend lines [markup
] lappend lines [ht_comment [c_provenance]] lappend lines [ht_comment "$la"] lappend lines [markup ] lappend lines "[markup ]" return } proc Meta {} { # Engine parameter - insert 'meta' set meta [Get meta] if {$meta == {}} return upvar 1 lines lines lappend lines [markup $meta] return } proc EndHeader {} { upvar 1 lines lines lappend lines [markup ] return } proc BeginBody {} { upvar 1 lines lines lappend lines [markup
] return } proc BodyHeader {} { upvar 1 lines lines # Engine parameter - insert 'header' set header [Get header] if {$header == {}} return lappend map @TITLE@ [TheTitle] set header [string map $map $header] lappend lines [markup $header] return } proc TheTitle {} { global la ti set title ??? if {($la != {}) && ($ti != {})} { set title "$la -- $ti" } elseif {$la != {}} { set title $la } elseif {$ti != {}} { set title $ti } return $title } proc Title {} { upvar 1 lines lines lappend lines "[markup

### ] [TheTitle] [markup

]" return } proc Navbar {} { global ch cnt dot upvar 1 lines lines set nav {} foreach c [lsort -dict [array names ch]] { set ref c[F $c];#[incr cnt] set ch($c) $ref lappend nav [ALink $ref $c] } lappend lines [markup "

"] lappend lines [join $nav $dot] lappend lines [markup
] return } proc BeginIndex {} { upvar 1 lines lines lappend lines [markup "

"] return } proc Keys {} { global key upvar 1 lines lines set lc {} set kwlist {} # For a good display we sort keywords in dictionary order. # We ignore their leading non-alphanumeric characters. set kwlist {} foreach kw [array names key] { set kwx [string trim [regsub -all {^[^a-zA-Z0-9]+} $kw {}]] lappend kwlist [list $kwx $kw] } foreach item [lsort -index 0 -dict $kwlist] { foreach {_ k} $item break set c [F $k] ; if {$lc != $c} { Section $c ; set lc $c } BeginKey $k References $k EndKey } return } proc Section {c} { global ch upvar 1 lines lines lappend lines [markup {
}] lappend lines [markup "Keywords: $c"] lappend lines [markup
] return } proc BeginKey {k} { upvar 1 lines lines lappend lines [markup "
"] lappend lines [BeginColLeft][SetAnchor $k][markup ] lappend lines [BeginColRight] return } proc EndKey {} { upvar 1 lines lines lappend lines [markup
] return } proc References {k} { global key dot upvar 1 lines lines set refs {} foreach {ref label} $key($k) { lappend refs [markup " $label "] } lappend lines [join $refs $dot] return } proc EndIndex {} { upvar 1 lines lines lappend lines [markup

] # Engine parameter - insert 'footer' set footer [Get footer] if {$footer == {}} return lappend lines [markup "

"] lappend lines [markup $footer] return } proc EndBody {} { upvar 1 lines lines lappend lines [markup "
"] return } proc ALink {dst label} { markup " $label " } proc BeginColLeft {} { return [markup {}] } proc BeginColRight {} { return [markup {}] } proc SetAnchor {text} { return [markup " $text "] } proc A {text} { set anchor [regsub -all {[^a-zA-Z0-9]} [string tolower $text] {_}] set anchor [regsub -all {__+} $anchor _] return $anchor } proc Anchor {text} { global kwid if {[info exists kwid($text)]} { return "\"$kwid($text)\"" } return "\"[A $text]\"" } proc Row {} { global even set res [expr {$even ? "\#doctools_idxeven" : "\#doctools_idxodd"}] Flip return $res } proc Flip {} { global even set even [expr {1-$even}] return } # ### ### ### ######### ######### ######### ## Engine state # key : string -> dict(ref -> label) "key formatting" # ch : string -> '.' "key starting characters" # lk : string "last key" # la : string "index label" # ti : string "index title" # cnt : int # kwid : string -> ... # even : bool global key ; array set key {} global ch ; array set ch {} global lk ; set lk {} global la ; set la {} global ti ; set ti {} global cnt ; set cnt 0 global kwid ; array set kwid {} global even ; set even 1 global dot ; set dot [markup { · }] # ### ### ### ######### ######### ######### ## Engine parameters global __var array set __var { meta {} header {} footer {} kwid {} raw 0 } proc Get {varname} {global __var ; return $__var($varname)} proc idx_listvariables {} {global __var ; return [array names __var]} proc idx_varset {varname text} { global __var if {![info exists __var($varname)]} {return -code error "Unknown engine variable \"$varname\""} set __var($varname) $text return } ## # ### ### ### ######### ######### #########