Documentation Source Text

Artifact d12bd6e600c18da6f13e0dc3840c9cfb04ba6bde:

• File pages/fancyformat.tcl — part of check-in [0c8678b577] at 2010-11-13 19:00:19 on branch trunk — Move the examples on lang_explain.html to new document eqp.html. (user: dan size: 11481)

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)
}