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

  1. # HTML <> commands per http://wiki.tcl.tk/2776
  2. know {[string match <*> [lindex $args 0]]} {
  3. set tag [string trim [lindex $args 0] "<>"]
  4. set mod [string index $tag end]
  5. set mod [dict get? {! {[uplevel 1 $content]} + {[uplevel 1 [list subst $content]]}} $mod]
  6. if {$mod ne ""} {
  7. set mod [dict get $::Html::tagmods $mod]
  8. set htag [string trimright [dict keys $::Html::tagmods]]
  9. } else {
  10. set mod {$content} ;# default just returns content
  11. set htag $tag
  12. }
  13.  
  14. ::proc ::<$tag> {args} [string map [list @T@ $htag @M@ $mod] {
  15. if {[llength $args]%2} {
  16. set content [lindex $args end]
  17. set args [lrange $args 0 end-1]
  18. } else {
  19. set content {}
  20. }
  21. set class {}
  22. set result "@T@"
  23. foreach {n v} $args {
  24. if {$n eq "class"} {
  25. lappend class $v ;# aggregate class args
  26. } else {
  27. lappend result "[string trim $n]='[armour [string trim $v]]'"
  28. }
  29. }
  30. if {$class ne {}} {
  31. lappend result "class='[join $class]'"
  32. }
  33. return "<[join ${result}]>@M@</@T@>"
  34. }]
  35.  
  36. return [{*}$args]
  37. }