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 ... ## TODO } } } return $html } #<<<<<<<<<<<< ::webutils::tmlparse >>>>>>>>>>>>>># # tmlparse arrayName specFile ?specFile2? ... ?specFileN? # Returns list of page names defined by TML data # # TML File format: # <<>> # ... # <<>> # com gov edu de au etc. etc. # ... # <<>> # keyphrase linkexp # ... # <<>> # keyphrase {attr value ...} # ... # <<>> # paramA {attr value pairs} {tag body} # ... # paramB {attr value pairs} {tag body} # ... # <<>> # Plain text with [TCL procs] to generate any common HTML (at page top) # ... # <<>> # (or) # <<>> # paramC {attr value pairs} {tag body} # ... # paramD {attr value pairs} {tag 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 <<>> 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 ? ?-wwwclass ? ?-domains ? ?-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 # 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\;} {&} {\\&\;} {\\&\;} {<} {\\<\;} {\\<\;} {>} {\\>\;} {\\>\;} } # 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 ? headList stringName # smart = specify if proc should try using smart quotes # Returns block proc ::webutils::headset { styleList } { # TODO # Proc body here return } #<<<<<<<<<<<< ::webutils::styleset (internal) >>>>>>>>>>>>>># # styleset styleList # Returns block proc ::webutils::styleset { styleList } { # TODO # Proc body here return $result } ====== <> Internet