# 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 ] $la [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 {]
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
}
##
# ### ### ### ######### ######### #########