catch { array unset ::SectionNumbers }
set ::SectionNumbers(1) 0
set ::SectionNumbers(2) 0
set ::SectionNumbers(3) 0
set ::SectionNumbers(fig) 0
catch { set TOC "" }
catch { array unset ::References }
proc H {iLevel zTitle {zName ""} args} {
set zNumber ""
for {set i 1} {$i <= 4} {incr i} {
if {$i < $iLevel} {
append zNumber "$::SectionNumbers($i)."
}
if {$i == $iLevel} {
append zNumber "[incr ::SectionNumbers($i)]."
}
if {$i > $iLevel} {
set ::SectionNumbers($i) 0
}
}
set zNumber [string range $zNumber 0 end-1]
if {$zName == ""} {
set zName "section_[string map {. _} $zNumber]"
} else {
set ::References($zName) [list $zNumber $zTitle]
}
if {$args != ""} {
#puts $args
set ::hd(fragment) $zName
eval hd_keywords $args
}
append ::TOC [subst {
<div style="margin-left:[expr $iLevel*6]ex">
<a href="#$zName">${zNumber} $zTitle</a>
</a></div>
}]
return "<h$iLevel id=\"$zName\">$zNumber $zTitle</h$iLevel>\n"
}
proc h1 {args} {uplevel H 1 $args}
proc h2 {args} {uplevel H 2 $args}
proc h3 {args} {uplevel H 3 $args}
proc h4 {args} {uplevel H 4 $args}
proc fancyformat_fragment {name args} {
global hd
set hd(fragment) $name
eval hd_keywords $args
return "<a name=\"$name\"></a>"
}
proc Fig {zImage zCaption} {
subst {
<center>
<img src="images/$zImage">
<p><i>$zCaption</i>
</center>
}
}
proc Figure {zImage zName zCaption} {
incr ::SectionNumbers(fig)
set ::References($zName) [list $::SectionNumbers(fig) $zCaption]
if {[regexp {.*svg} $zImage ]} {
set fd [open $::DOC/images/$zImage]
set nLine 0
while {![eof $fd] && $nLine<30} {
set line [gets $fd]
regexp {^ *width="([0123456789]*)} $line dummy iWidth
regexp {^ *height="([0123456789]*)} $line dummy iHeight
incr nLine
}
close $fd
incr iWidth
incr iHeight
set tag "<object data=\"images/$zImage\" type=\"image/svg+xml\" width=$iWidth height=$iHeight style=\"overflow:hidden\"></object>"
} else {
set tag "<img src=\"images/fileformat/$zImage\">"
}
subst {
<center>
<a name="$zName"></a>
$tag
<p><i>Figure $::SectionNumbers(fig) - $zCaption</i>
</center>
}
}
proc sort_by_length {lhs rhs} {
return [expr [string length $lhs] - [string length $rhs]]
}
set ::Random 0
proc randomstring {} {
incr ::Random
return [expr $::Random + rand()]
}
proc Ref {no id details} {
set ::References($id) "\[$no\]"
return "<tr><td style=\"width:5ex ; vertical-align:top\" id=\"$id\">\[$no\]<td>$details"
}
proc FixReferences {body} {
if {[info commands hd_resolve_2ndpass] ne ""} return
set l [list]
foreach E [lsort -decr -index 1 -command sort_by_length $::Glossary] {
# puts $E
foreach {term anchor} $E {}
set re [string map {" " [-[:space:]]+} $term]
set re "${re}s?"
while { [regexp -nocase $re $body thisterm] } {
set xxx [randomstring]
set body [regsub -nocase $re $body $xxx]
lappend l $xxx "<a class=defnlink href=\"#$anchor\">$thisterm</a>"
}
# set body [regsub -all -nocase $re $body "<a class=defnlink href=\"#$anchor\">\\0</a>"]
# set body [regsub -all -nocase {(defnlink[^<]*) } $body "\\1&20;"]
}
foreach R $::Requirements {
set body [regsub -all "(\[^=\])$R" $body "\\1<a class=reqlink href=#$R>$R</a>"]
}
foreach {key value} [array get ::References] {
foreach {zNumber zTitle} $value {}
lappend l <cite>$key</cite> "<cite><a href=\"#$key\" title=\"$zTitle\">$zNumber</a></cite>"
}
set body [string map $l $body]
}
set ::Glossary {}
proc Glossary {term definition} {
set anchor [string map {" " _ ' _} $term]
set anchor "glossary_$anchor"
lappend ::Glossary [list $term $anchor]
return "<tr><td class=defn><a name=\"$anchor\"></a>$term <td>$definition"
}
# Procs to generate <table> and <tr> tags. They also give alternating rows
# of the table a grey background, which can make it easier to read.
#
proc Table {} {
set ::Stripe 1
return "<table style=\"margin:1em auto;width:80%;border-spacing:0\">"
}
proc Tr {} {
set ::Stripe [expr {($::Stripe+1)%2}]
if {$::Stripe} {
return "<tr style=\"text-align:left;background-color:#DDDDDD\">"
} else {
return "<tr style=\"text-align:left\">"
}
}
proc fancyformat_import_requirement {reqid} {
lappend ::Requirements $reqid
set ret "<p class=req id=$reqid><span>[lindex $::ffreq($reqid) 1]</span>"
if {[llength [lindex $::ffreq($reqid) 0]]} {
append ret " (P: [lindex $::ffreq($reqid) 0])"
}
if {[info exists ::ffreq_children($reqid)]} {
append ret " (C: $::ffreq_children($reqid))"
}
append ret "</p>"
}
set ::Requirements [list]
proc Code {txt} {
set txt [string trim $txt "\n"]
set out {<div class=codeblock style="margin:0 15ex">}
append out {<table width=100% style="border:1px solid #80a796;padding:0 1ex;background-color:#EEEEEE"><tr><td><pre style="font-size:1.1em">}
foreach line [split $txt "\n"] {
if {![string is space $line]} {
set nSpace [expr {
[string length $line] - [string length [string trimleft $line]]
}]
if {[info exists nMinSpace]==0 || $nSpace<$nMinSpace} {
set nMinSpace $nSpace
}
}
}
foreach line [split $txt "\n"] {
set line [string range $line $nMinSpace end]
append out "$line\n"
}
append out "</table></div>"
return $out
}
proc fancyformat_document {zTitle lReqfile zBody} {
unset -nocomplain ::ffreq
unset -nocomplain ::ffreq_children
foreach f $lReqfile {
hd_read_requirement_file $::DOC/req/$f ::ffreq
}
foreach req [array names ::ffreq] {
foreach parent [lindex $::ffreq($req) 0] {
lappend ::ffreq_children($parent) $req
}
}
set PREAMBLE {}
if {$zTitle == "SQLite Database File Format"} {
set PREAMBLE {<link type="text/css" rel="stylesheet" href="images/fileformat/rtdocs.css">}
}
set body [subst -novariables $zBody]
hd_resolve [subst {
$PREAMBLE
<div class=fancy>
<div style="font-size:2em;text-align:center;color:#80a796">$zTitle</div>
<div style="font-size:1.5em;margin:1em;color:#80a796">Table Of Contents</div>
<div id=toc>
$::TOC
</div id>
[FixReferences $body]
}]
}
proc addtoc_cb {tag details} {
upvar #0 ::Addtoc G
switch -glob -- $tag {
"" { ;# Text node. Copy the text to the output. And the TOC, if applicable.
if {$G(inCodeblock)} {
append G(codeblock) $details
} else {
append G(doc) $details
if {$G(inHeading)} { append G(toc) $details }
if {$G(inTitle)} { append G(title) $details }
}
}
h[1-6] { ;# A heading.
array set D $details
set level [string range $tag 1 end]
set HN ""
if {![info exists D(notoc)]} {
if {![info exists D(nonumber)]} { set HN [headingnumber $level] }
# If the heading does not have an 'id' attribute, generate one.
if {[info exists D(id)]==0} {
if {$HN != ""} {
set D(id) "section_[string map {. _} [string range $HN 0 end-1]]"
} else {
set D(id) "notoc[incr G(notoccounter)]"
}
}
# Append the entry to the table-of-contents.
append G(toc) "<div style=\"margin-left:[expr $level*6]ex\">"
append G(toc) "<a href=\"#$D(id)\">$HN "
set G(inHeading) 1
}
catch { unset D(nonumber) }
catch { unset D(notoc) }
# If there is a "tags" attribute, then add an [hd_fragment] command
# to the output.
if {[info exists D(tags)]} {
append G(doc) "<tcl>[list set ::hd(fragment) $D(id)]</tcl>"
foreach t [split $D(tags) ,] {
append G(doc) "<tcl>[list hd_keywords [string trim $t]]</tcl>"
}
unset D(tags)
}
append G(doc) [formattag $tag [array get D]]
append G(doc) "$HN "
}
/h[1-6] { ;# End of current heading.
if {$::Addtoc(inHeading)} {
append G(toc) "</a></div>"
}
set G(inHeading) 0
append G(doc) [formattag $tag $details]
}
title {
set G(inTitle) 1
append G(doc) [formattag $tag $details]
}
/title {
set G(inTitle) 0
append G(doc) [formattag $tag $details]
}
codeblock { set G(inCodeblock) 1 }
/codeblock {
append G(doc) [Code $G(codeblock)]
set G(codeblock) ""
set G(inCodeblock) 0
}
table {
catch {array unset D}
array set D $details
if {[info exists D(striped)]} {
unset D(striped)
set D(style) "margin:1em auto; width:80%; border-spacing:0"
set G(inStripedTable) 1
}
append G(doc) [formattag $tag [array get D]]
}
/table {
set G(inStripedTable) 0
append G(doc) [formattag $tag [array get D]]
}
tr {
catch {array unset D}
array set D $details
switch $G(inStripedTable) {
1 {
set D(style) "text-align:left"
set G(inStripedTable) 2
}
2 {
set D(style) "text-align:left;background-color:#DDDDDD"
set G(inStripedTable) 1
}
}
append G(doc) [formattag $tag [array get D]]
}
default {
if {$G(inCodeblock)} {
append G(codeblock) [formattag $tag $details]
} else {
append G(doc) [formattag $tag $details]
}
}
}
}
proc formattag {tag details} {
set ret "<$tag"
foreach {key value} $details {
append ret " $key=\"$value\""
}
append ret ">"
set ret
}
proc headingnumber {level} {
upvar #0 ::Addtoc G
set ret ""
incr G(heading:$level)
for {set i 1} {$i < 6} {incr i} {
if {$i > $level} {
set G(heading:$i) 0
} else {
append ret "$G(heading:$i)."
}
}
set ret
}
proc addtoc {zDoc} {
# If the extension with the [parsehtml] command has not been loaded,
# load it now.
#
if {[info commands parsehtml] == ""} { load ./parsehtml.so }
# These variables are all used to store state between invocations of
# the [parsehtml] callback used to do preprocessing.
#
set ::Addtoc(heading:1) 0
set ::Addtoc(heading:2) 0
set ::Addtoc(heading:3) 0
set ::Addtoc(heading:4) 0
set ::Addtoc(heading:5) 0
set ::Addtoc(heading:6) 0
set ::Addtoc(inHeading) 0
set ::Addtoc(inTitle) 0
set ::Addtoc(inCodeblock) 0
set ::Addtoc(inStripedTable) 0
set ::Addtoc(notoccounter) 0
set ::Addtoc(codeblock) ""
# The following three are set by the [parsehtml] callback. The title,
# table-of-contents and text of the pre-processed document.
#
set ::Addtoc(title) ""
set ::Addtoc(toc) ""
set ::Addtoc(doc) ""
parsehtml $zDoc addtoc_cb
# Variable $toc is set to the HTML text for the table of contents. The
# text "<table_of_contents>" in the input file will be replaced by
# this text. The "<div class=startsearch>" tag tells the script that
# builds the site-search database not to index any text that occurs
# before it. This stops the table of contents from being used for
# snippets on search results pages.
#
set toc [subst {
<div class=fancy>
<div style="font-size:2em;text-align:center;color:#044a64">
$::Addtoc(title)
</div>
<div style="font-size:1.5em;margin:1em;color:#044a64">
Table Of Contents</div>
<div id=toc> $::Addtoc(toc) </div>
<div class=startsearch></div>
}]
string map [list <table_of_contents> $toc] $::Addtoc(doc)
}