sbron 30 jun 2016: A while ago it occurred to me that generating HTML would be much easier if you could write it as if it were Tcl. So for example, something like this:
html {
head {
title {str "HTML demo"}
meta -charset utf-8
script -type text/javascript -src demo.js
}
body -onload onloadfunc() {
global env
h1 {str "Patch level: "; font -color blue {info patchlevel}}
a -href http://wiki.tcl.tk/44439 {str "Source code"}
p
table -border 1 -cellspacing 0 {
tr -style {background: yellow;} {
foreach n {Name Value} {
th {str $n}
}
}
dict for {name value} [array get env H*] {
if {[string length $value] > 20} continue
tr {
td {str $name}
td {str $value}
}
}
}
}
}It took a bit of hacking, but I've been using the code below for a while and so far it works quite nicely.
namespace eval html {
namespace export html
namespace eval gen {}
namespace path gen
# Helper command to create commands for html tags
proc createtag {args} {
::foreach tag $args {
::proc $tag args [format {tailcall tag %s {*}$args} $tag]
}
}
# Command that simply returns the string passed to it
proc str {str} {return $str}
proc % {args} {return [join $args]}
proc nbsp {{str ""}} {
if {$str ne ""} {
return $str
} else {
return { }
}
}
# Loop commands that collect the output of the commands in the loop body
proc foreach args {
tailcall htmleach {*}$args
}
proc for {init test next body} {
tailcall htmlfor $init $test $next $body
}
proc while {test body} {
tailcall htmlfor {} $test {} $body
}
# Create an alternative dict ensemble
namespace ensemble create -command dict \
-map [dict replace [namespace ensemble configure dict -map] \
for gen::dictfor set gen::dictset]
# Versions of commands that should not generate output
proc set {var val} {
uplevel 1 [list ::set $var $val]
return
}
proc append {var args} {
uplevel 1 [list ::append $var {*}$args]
return
}
proc incr {var {val 1}} {
uplevel 1 [list ::incr $var $val]
return
}
proc lset {args} {
uplevel 1 [list ::lset {*}$args]
return
}
proc lappend {var args} {
uplevel 1 [list ::lappend $var {*}$args]
return
}
proc if {test args} {
tailcall htmlif $test $args
}
proc html args {
tag html {*}$args
}
# Create procs for the most common html tags
createtag head body title link meta script style frame frameset noframes
createtag i b u font samp span address cite em kbd code tt var sub sup
createtag a img br hrule p pre blockquote div center iframe legend
createtag h1 h2 h3 h4 h5 h6 ul ol li dl dt dd dir
createtag table tbody caption colgroup col tr th td
createtag form input select optgroup option button textarea label fieldset
# Redefine proc (for this namespace only!)
proc proc {name arglist body} {
::set func [list $arglist]
::lappend func [format {return [runbody %s 1]} [list $body]]
::lappend func [namespace current]
::set template {tailcall apply %s {*}[lrange [info level 0] 1 end]}
::proc $name $arglist [format $template [list $func]]
}
}
proc html::gen::buildscript {level args} {
upvar 1 script script
append script {*}$args
set retval ""
set rc 0
if {![string is space $script]} {
if {![info complete $script]} {return $retval}
set rc [catch {uplevel $level $script} retval]
}
set script {}
return -code $rc $retval
}
proc html::gen::runbody {body {level 2}} {
set retval ""
incr level
foreach line [split $body \n] {
set rc [catch {
set chunks [lassign [split $line ";"] chunk]
append retval [buildscript $level $chunk]
foreach chunk $chunks {
append retval [buildscript $level ";" $chunk]
}
append retval [buildscript $level \n]
} str]
if {$rc != 0} {
append retval $str
return -code $rc $retval
}
}
return $retval
}
proc html::gen::quote {str} {
if {[string first {"} $str] < 0} {
# String doesn't contain double quotes so default quoting can be used.
return [format {"%s"} $str]
} elseif {[string first {'} $str] < 0} {
# String contains double quotes, but no single quotes.
return [format {'%s'} $str]
} else {
# Both types of quotes are present.
return [format {"%s"} [string map {\" "} $str]]
}
}
proc html::gen::tag {name args} {
if {[llength $args] & 1} {
set body [lindex $args end]
set args [lrange $args 0 end-1]
} else {
set body {}
}
set tag $name
foreach {option value} $args {
if {$option eq "-style"} {
set list [lsearch -all -inline -regexp [split $value ";\n"] {\S}]
set value "[join [lmap n $list {string trim $n}] {; }];"
}
append tag " " [string range $option 1 end]=[quote $value]
}
# Check for empty tags which don't get an endtag
# http://www.w3.org/TR/html401/index/elements.html
if {
$name in {
area base basefont br col frame hr
img input isindex link meta param
}
} {
return <$tag>\n
}
set rc 0
set str ""
if {$body ne ""} {
set rc [catch {runbody $body} str]
}
if {[string first \n $str] >= 0} {
set retval "<$tag>\n[string trimright $str \n]\n</$name>"
} else {
set retval "<$tag>$str</$name>"
}
if {$name ni {html b i}} {
append retval \n
}
return -code $rc $retval
}
proc html::gen::htmlif {test rest} {
# Figure out which body to execute, if any
while {[llength $rest]} {
set rest [lassign $rest body]
if {$body eq "then"} {set rest [lassign $rest body]}
if {[uplevel 1 [list expr $test]]} {
break
} else {
set rest [lassign $rest body]
if {$body eq "elseif"} {
set rest [lassign $rest test]
} else {
if {$body eq "else"} {
set rest [lassign $rest body]
}
break
}
}
set body {}
}
# Run the selected body and collect the results
set rc [catch {runbody $body} retval]
return -code $rc $retval
}
proc html::gen::htmleach {args} {
# Use weird variable names to minimize the risk of a clash
set j7idQ?nC [lindex $args end]
set 3^mIF9h, [lrange $args 0 end-1]
foreach {n -} ${3^mIF9h,} {
foreach v $n {
lappend varlist $v $v
}
}
unset n v args
upvar 1 {*}$varlist
set Vk2|.n!J ""
foreach {*}${3^mIF9h,} {
set 6HPr_#MK [catch {runbody ${j7idQ?nC}} ^j%LOmyc]
append Vk2|.n!J ${^j%LOmyc}
if {${6HPr_#MK} == 2 || ${6HPr_#MK} == 3} break
}
return ${Vk2|.n!J}
}
proc html::gen::htmlfor {init test next body} {
set retval ""
uplevel 1 $init
while {[uplevel 1 [list expr $test]]} {
set rc [catch {runbody $body} str]
append retval $str
if {$rc == 3} break
if {$rc == 2} {return -code $rc $retval}
uplevel 1 $next
}
return $retval
}
proc html::gen::dictset {var args} {
uplevel 1 [list ::dict set $var {*}$args]
return
}
proc html::gen::dictfor {vars dict body} {
lassign $vars keyvar valvar
upvar 1 $keyvar key $valvar val
set retval ""
dict for {key val} $dict {
set rc [catch {runbody $body} str]
append retval $str
if {$rc == 3} break
if {$rc == 2} {return -code $rc $retval}
}
return $retval
}
namespace import html::htmlWith this code loaded, sourcing the code mentioned at the start returns a reasonable HTML page.
