Posted to tcl by colin at Thu Sep 15 22:24:26 GMT 2011view pretty

# HTML <> commands per http://wiki.tcl.tk/2776
know {[string match <*> [lindex $args 0]]} {
    set tag [string trim [lindex $args 0] "<>"]
    set mod [string index $tag end]
    set mod [dict get? {! {[uplevel 1 $content]} + {[uplevel 1 [list subst $content]]}} $mod]
    if {$mod ne ""} {
        set mod [dict get $::Html::tagmods $mod]
        set htag [string trimright [dict keys $::Html::tagmods]]
    } else {
        set mod {$content}	;# default just returns content
        set htag $tag
    }

    ::proc ::<$tag> {args} [string map [list @T@ $htag @M@ $mod] {
        if {[llength $args]%2} {
            set content [lindex $args end]
            set args [lrange $args 0 end-1]
        } else {
            set content {}
        }
	set class {}
	set result "@T@"
	foreach {n v} $args {
	    if {$n eq "class"} {
		lappend class $v	;# aggregate class args
	    } else {
		lappend result "[string trim $n]='[armour [string trim $v]]'"
	    }
	}
	if {$class ne {}} {
	    lappend result "class='[join $class]'"
	}
	return "<[join ${result}]>@M@</@T@>"
    }]

    return [{*}$args]
}