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 SuominenRegistered 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\;}
{&} {\\&\;} {\\&\;}
{<} {\\<\;} {\\<\;}
{>} {\\>\;} {\\>\;}
}
# 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
}
