listtemplate

Lars H, 2010-03-26: Doing some late winter cleaning (spring won't arrive up here for a few weeks yet), I came across the following little proc which looks useful although it won't fit in with the rest of the package I originally wrote it for. Hence giving it a page on the wiki seems a reasonable housing arrangement.

What it is about is template-based construction of lists. My motivating example was command prefixes (of a complicated sort, which would often contain other command prefixes as elements), but it might well be useful also for other things.

One way of thinking about it is as a sort of format for lists.

## 
 # listtemplate -
 #   minilanguage for constructing lists (e.g. command prefixes)
 # 
 # Synopsis:
 #   listtemplate $template ?$parameter ...?
 # 
 #   The $template is a list, from which another list (the result) 
 #   is built. The following strings will, if encountered as list 
 #   elements, be interpreted as preprocessing directives rather 
 #   than explicit list elements:
 #   
 #     #<number>
 #       Appends the <number>th (0-based index) $parameter to the list 
 #       being constructed.
 #     
 #     #*<number>
 #       Interprets the <number>th $parameter as a list and appends 
 #       its elements to the list being constructed.
 #     
 #     #{
 #       Begins sublist.
 #     
 #     #}
 #       Ends sublist, and contributes it as one list element to the 
 #       surrounding list.
 #     
 #     #eval
 #       The next $template element is evaluated in the calling 
 #       context, and the result is appended to the list being 
 #       constructed.
 #     
 #     #nswc
 #       The next template element is in the calling context given 
 #       as an argument to [namespace which -command], and the 
 #       result of that is appended to the list being constructed.
 #       
 #     #nswv
 #       The next template element is in the calling context given 
 #       as an argument to [namespace which -variable], and the 
 #       result of that is appended to the list being constructed.
 #     
 #     ##
 #       Escapes directive-interpretation of next template element.
 #     
 #     #
 #       Next template element is ignored; can be used to embed 
 #       a comment.
 #   
 #   A template element is assumed to be a directive if and only if 
 #   its first character is #.
 # 
 # Side-effects: None.
 # 
 ##

proc listtemplate {template args} {
    set state normal
    set stack {}
    set res {}
    foreach item $template {
        switch -- $state normal {
            if {[string index $item 0] != "#"} then {
                lappend res $item
                continue
            }
            switch -regexp -- $item {^#\{$} {
                lappend stack $res
                set res {}
            } {^#\}$} {
                if {[llength $stack]} then {
                    set res [linsert [lindex $stack end] end $res]
                    set stack [lreplace $stack end end]
                } else {
                    error "Too many #\}"
                }
            } {^#[0-9]+$} {
                scan $item "#%d" index
                lappend res [lindex $args $index]
            } {^#\*[0-9]+$} {
                scan $item "#*%d" index
                eval [linsert [lindex $args $index] 0 lappend res]
            } {^#(eval|nswc|nswv)$} {
                set state [string range $item 1 end]
            } {^##$} {
                set state verbatim
            } {^#$} {
                set state ignore
            } default {
                error "Unknown directive: $item"
            }
        } verbatim {
            lappend res $item
            set state normal
        } eval {
            lappend res [uplevel 1 $item]
            set state normal
        } nswc {
            lappend res [uplevel 1 [list\
              ::namespace which -command $item]]
            set state normal
        } nswv {
            lappend res [uplevel 1 [list\
              ::namespace which -variable $item]]
            set state normal
        } ignore {
            set state normal
        }
    }
    if {$state != "normal"} then {
        error "Missing data for: $item"
    } elseif {[llength $stack]} then {
        error "[llength $stack] sublist(s) not properly closed"
    } else {
        return $res
    }
}

For example:

 % set w .win
 % listtemplate {#0 configure -xscrollcommand #{ #1 set #}} $w.c $w.h
 .win.c configure -xscrollcommand {.win.h set}