Updated 2011-07-07 22:15:56 by RLE

The code below is a now-aborted attempt to create an HTML compiler in TCL, using a Wiki-like format. I'm hoping to get some of the good stuff here integrated with the great new NoteBook App, and would appreciate any help or feedback on that.

Ed Suominen

Registered Patent Agent * Independent Inventor of EE Technology

Author, PRIVARIA Secure Networking Suite, freely available at http://www.privaria.org
 #  webutils -- Toolbox of utility procs for easy web site generation
 # $Revision: 1.5 $, $Date: 2002-09-26 08:01:14 $
 ########################################################################
 set license {
 Copyright (c) 2002, Edwin A. Suominen
 Registered Patent Agent * http://eepatents.com
 Author, PRIVARIA Secure Networking Suite
 Freely available at http://www.privaria.org
 
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are
 met:
 
 * Redistributions of source code must retain the above copyright
 notice, this list of conditions and the following disclaimer.
 
 * Redistributions in binary form must reproduce the above copyright
 notice, this list of conditions and the following disclaimer in the
 documentation and/or other materials provided with the distribution.
 
 * Neither the name of the author nor any contributor may be used to
 endorse or promote products derived from this software without
 specific prior written permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 }
 
 # Load packages
 foreach {i} {parse htmlgen} { package require $i }
 # Load html commands into our namespace
 namespace import -force ::htmlgen::*
 
 
 #<<<<<<<<<<<< NAMESPACE ::webutils:: >>>>>>>>>>>>>>#
 namespace eval ::webutils {
 
     namespace export -clear webgen tmlparse linksub tagsub keysub punctsub
 
 }
 #-----------------------------------------------
 
 
 #<<<<<<<<<<<< ::webutils::webgen >>>>>>>>>>>>>>#
 # webgen ?-file outPath? arrayName pageName
 # outPath       = Path for .html page(s) to be written (created if not present)
 # Returns HTML output for specified page, optionally also writes to outPath.html
 proc ::webutils::webgen { args } {
     parse::args {file.arg} {arrayName pageName} $args
 
     # Setup
     set html {}         ;# HTML string that we build from null
     set sortList {
         ## TODO
     }
 
     # Start with any common elements, then go on to page-specific elements
     foreach {i} [list common $pageName] {
 
         foreach {j k} [array get $arrayName $i*] {
 
             # Process each element according to its type
             switch -glob $j {
                 # Start with <HEAD>...</HEAD>
                 ## TODO
 
             }
         }
     }
 
     return $html
 }
 
 
 #<<<<<<<<<<<< ::webutils::tmlparse >>>>>>>>>>>>>>#
 # tmlparse arrayName specFile ?specFile2? ... ?specFileN?
 # Returns list of page names defined by TML data
 #
 # TML File format:
 # <<<???.styles>>>
 # ...
 # <<<???.domains>>>
 # com gov edu de au etc. etc.
 # ...
 # <<<???.links>>>
 # keyphrase linkexp
 # ...
 # <<<???.spans>>>
 # keyphrase {attr value ...}
 # ...
 # <<<common.head>>>
 # paramA {attr value pairs} {tag body} 
 # ...
 # paramB {attr value pairs} {tag body}
 # ...
 # <<<common.body>>>
 # Plain text with [TCL procs] to generate any common HTML (at page top)
 # ...
 # <<<page1.tml>>>
 # (or)
 # <<<page1.head>>>
 # paramC {attr value pairs} {tag body} 
 # ...
 # paramD {attr value pairs} {tag body}
 # ...
 # <<<page1.body>>>
 # Plain text with [TCL procs] to generate any page1 HTML
 # ...
 proc ::webutils::tmlparse { args } {
     # Destination array name is first arg
     upvar [lindex $args 0] KEYS
 
     ### Read spec files into one big string
     set tmlString {}
     foreach {i} [lrange $args 1 end] {
         # Open settings file for reading
         set err [catch {set fh [open $i r]} errorMsg] 
         if { $err } {
             error "TML File Read Error: $errorMsg"
 
         } else {
             # Append each non-commented, non-blank line to string
             while { ![eof $fh] } {
                 # Get first (or next) line of file
                 gets $fh inLine
                 # Append line if not blank or comment
                 if { ![regexp {^#} $inLine] && ( [string length $inLine] > 1 ) } {
                     set tmlString "$tmlString\n$inLine"
                 }
             }
             # Done reading file, so close it
             close $fh
         }
     }
 
     ### Iteratively substitute in all <<<xxx.tml>>> macros
     while {
         [regexp -nocase -indices {(<)<<[^>]+\.tml>>(>)} $tmlString null x y]
     } {
         set k1 [lindex $x 0]
         set k2 [lindex $y 0]
         set fname [string range "$tmlString" \
             [expr { $k1+3 }] [expr { $k2-3 }] ]
         if { ![catch { set fh [open $fname] }] } {
             set tmlString [string replace $tmlString $k1 $k2 [read $fh]]
             close $fh
         }
     }
 
     ### Get indices to all keywords
     set match 1; set k -1
     while {$match} {
         set match [regexp -start [expr $k+1] -indices \
             {(<)<<[^>]*>>(>)} $tmlString null x y]
         if {$match} {
              lappend keyList [lindex $x 0]
              set k [expr { [lindex $y 0]-1 }]
         }
     }
 
     ### Populate array with keyword sections, using keywords as indices
     # Create list of page names in the process
     set pageList {}
     set n [expr { [llength $keyList]-1 }]
     for {set i 0} {$i<$n} {incr i} {
         set k0 [lindex $keyList $i]
         if { $i < $n-1 } {
             set k1 [expr { [lindex $keyList [expr {$i+1}] ]-1 }]
         } else {
             set k1 end
         }
         if { [regexp {<<<([^\.>]+)\.([^>]+)>>>(.*)} [string range $tmlString $k0 $k1] null x y z] } {
             array set KEYS [list $x.$y $z]
             # Add page name to list if not 'common' and not in list already
             if { ![string match $x common] && ( [lsearch $pageList $x] < 0 ) } {
                 lappend pageList $x
             }
         }
     }
 
     return $pageList
 }
 
 
 #<<<<<<<<<<<< ::webutils::xmlsub (internal) >>>>>>>>>>>>>>#
 proc ::webutils::xmlsub { tag attrList keyword string } {
     foreach {i j} $attrList {
         lappend attrs $i=$j
     }
     set x [eval ::xmlgen::doTag $tag $attrs $keyword]
     # Now do the full substitution
     regsub -all [subst {\x20$keyword\(\[^a-zA-Z<\])}] $string [subst {\x20$x\\1}] string
 
     return $string
 }
 
 
 #<<<<<<<<<<<< ::webutils::expsub (internal) >>>>>>>>>>>>>>#
 proc ::webutils::expsub { exp string buffer subPlace } {
     # One loop iteration for each keyphrase match
     while {
         [regexp -indices "\[^a-zA-Z\<\>\]($exp)\[^a-zA-Z\<\>\]" $string null x]
     } {
         # Get match string
         set y [eval string range [subst -nocommands {{$string}}] $x]
         # In buffer, substitute match string for substitution
         # placeholder (e.g., "%1%")
         regsub -all $subPlace $buffer $y buffer
         # Replace match in main string with prepared buffer
         set string [eval string replace \
             [subst -nocommands {{$string}}] $x [subst {{$buffer}}] ]
     }
     return $string
 }
 
 
 #<<<<<<<<<<<< ::webutils::linksub >>>>>>>>>>>>>>#
 # linksub ?-class <class>? ?-wwwclass <wwwclass>? ?-domains <list>? ?-autowww? subList string
 # class         = CSS class name for normal links
 # wwwclass      = CSS class name for links starting with "www."
 # domains       = list of recognized domains, without leading "."
 # subList       = keyword/link pairs. "http://" will be added if
 #                 omitted and link is to a known domain from optional
 #                 list -domains <list>
 # Returns modified string
 proc ::webutils::linksub { args } {
     parse::args {class.arg wwwclass.arg domains.arg autowww} {subList string} $args
 
     if { [info exists domains] } {
         set test "\{("
         foreach {i} $domains {
             set test "$test$i|"
         }
         set test "[string range $test 0 end-1])\}"
     } else {
         set test {impossible_regexp_match}
     }
 
     if { [info exists autowww] } {
         if { [info exists wwwclass] } {
             set moreAttr [list class $wwwclass]
         } else {
             set moreAttr {}
         }
         while { [regexp {[^>/]www\.[^\x20,]+} $string match] } {
             set string [xmlsub h [concat href $x $moreAttr] $match $string]
         }
     }
 
     foreach {i j} $subList {
         # Apply appropriate CSS class if specified
         if { [string match www.* $i] && [info exists wwwclass] } {
             set moreAttr [list class $wwwclass]
         } elseif { [info exists class] } {
             set moreAttr [list class $class]
         } else {
             set moreAttr {}
         }
         # Create the substitution string
         # No clue why the 'eval' is needed, but it is
         if { ![string match http://* $j] && [eval regexp $test $j] } {
         set x "http://$j"
         } else {
             set x $j
         }
         # Now do the full substitution for keyword in question
         set string [xmlsub h [concat href $x $moreAttr] $i $string]
     }
 
     return $string
 }     
 
 
 #<<<<<<<<<<<< ::webutils::keysub >>>>>>>>>>>>>>#
 # keysub subList string
 # subList       = { keyphrase {expanded result} ...}
 # Returns modified string
 proc ::webutils::keysub { args } {
     parse::args {} {subList string} $args
     
     foreach {i j} $subList {
         # Define what is substituted in, with %1% for enclosing target text
         buffer x $j
         # Now substitute each match to keyphrase with buffer contents,
         # except with any %1% in buffer replaced by match
         set string [expsub $i $string $x %1%]
     }
 
     return $string
 }
 
 
 #<<<<<<<<<<<< ::webutils::tagsub >>>>>>>>>>>>>>#
 # tagsub subList stringName
 # subList       = { keyTag1 keyTag2 {HTML %1%} ...}
 # Modifies string in stringName
 proc ::webutils::tagsub { args } {
     parse::args {} {subList stringName} $args
 
     foreach {i j k} $subList {
         # Define what is substituted in
         switch $j {
             ! {
                 buffer x $k
                 regsub %1% $x $i x
             } - {
                 set x $k
             }
         }
         # Now do the full substitution
         # TODO
         regsub -all \
             [subst {(^|\\n)$i\\x20+(\[^\\n\]+)(\\n|$)}] \
             $string [subst {\\1$x\\2\\3}] string
     }
 
     return
 }
 
 
 #<<<<<<<<<<<< ::webutils::punctsub >>>>>>>>>>>>>>#
 # punctsub ?-smart? stringName
 # smart         = specify if proc should try using smart quotes
 # Returns modified string
 proc ::webutils::punctsub { args } {
     parse::args {smart} {string} $args
 
     set subList {
         {\ '(\[^\\x20\]|\[^s\]\[^\x20\])}       { \\&\#8216\;\\1}   { '\\1}
         {'}                                     {\\&\#8217\;}       {'}
         {(\[\\x20\(\])\"}                       {\\1\\&\#8220\;}    { \\&\#34\;\\1}
         {\"}                                    {\\&\#8221\;}       {\\&\#34\;}
         {&}                                     {\\&amp\;}          {\\&amp\;}
         {<}                                     {\\&lt\;}           {\\&lt\;}
         {>}                                     {\\&gt\;}           {\\&gt\;}
     }
     # Now do the substitutions for each punctuation mark found
     foreach {i j k} $subList {
         set x [expr { [info exists smart] ? $j : $k }]
         set keepLooping [regsub -all [subst $i] $string [subst $x] string]
     }
 
     return $string
 }
 
 
 #<<<<<<<<<<<< ::webutils::headset >>>>>>>>>>>>>>#
 # headset ?-style <styleList>? headList stringName
 # smart         = specify if proc should try using smart quotes
 # Returns <style>...</style> block
 proc ::webutils::headset { styleList } {
 
     # TODO
     # Proc body here
 
     return
 }
 
 
 #<<<<<<<<<<<< ::webutils::styleset (internal) >>>>>>>>>>>>>>#
 # styleset styleList
 # Returns <style>...</style> block
 proc ::webutils::styleset { styleList } {
 
     # TODO
     # Proc body here
 
     return $result
 }