Yet Another Field Mapper

Hopefully someone who needs to use maps for ttk::entry widgets might find this useful. With any luck I'll have transposed it correctly, and it should just work.

I don't find this very user-friendly. The template doesn't show until you edit a sufficient number of characters. What's worse, a backspace after a fixed character does nothing -- you're forced to step over the character using the mouse or an arrow key. And if you move around a bit you can really get the widget confused. For example, in the second example field I somehow ended up with 999//9/9/9, with backspace refusing to delete anything. You better not use this in any production code just yet...

OK, I've made some repairs, and indeed had to change the interface slightly, to incoroporate the %d parm, which is insert/delete. While not a big deal at this stage, it has made editing the fields much more reasonable ... HTH ... Rob.


 #
 # A Tcl/Tk Data Entry poor man's template package.
 # Written by Rob Sciuk of Control-Q Research 2008
 #
 # Usage terms as with the same BSD license as Tcl/Tk.
 # eg: use it for whatever you'd like ... but don't
 # call me when something breaks ;-)
 #
 # data entry package, adds template input ...
 # eg:   {(999) 999-9999}
 #       {9999/99/99}
 #       {99:99:99}
 # note, a <SPACE> will delete the entry ...
 # sample code at bottom.
 #
 namespace eval de {
        array set edt_mode {0 delete 1 insert}

        # map:  9       digit
        #       A       alpha
        #       X       Alpha numeric
        #       .       sep character (Literal)
        proc fmtChar chr {
                if [string equal "9" $chr] {
                        return digit
                }
                if [string equal "A" $chr] {
                        return alpha
                }
                if [string equal "X" $chr] {
                        return alnum
                }
                return literal
        }

        proc Mapper { map wdg key typ } {
                if { $typ < 0 } {
                        return 1
                }
                set mode $de::edt_mode($typ)
                if [string equal $mode delete] {
                        return 1
                }
                if ![string is print $key] {
                        return 1
                }
                if [string equal " " $key] {
                        if [$wdg selection present] {
                                $wdg delete sel.first sel.last
                                return 1
                        }
                        $wdg delete 0 end
                        return 1
                }
                set val [$wdg get]
                set ix [string length $val]
                set mx [string length $map]
                if { $ix == $mx } {
                        return 0
                }
                set fm [string index $map $ix]
                set tst [fmtChar $fm]
                switch $tst {
                        digit -
                        alpha -
                        alnum {
                                if [string is $tst $key] {
                                        return 1
                                }
                                return 0
                        }
                        literal {
                                while { [string equal literal $tst] == 1 } {
                                        $wdg insert end $fm
                                        incr ix
                                        set fm [string index $map $ix]
                                        set tst [fmtChar $fm]
                                }
                                if [string is $tst $key] {
                                        $wdg insert end $key
                                        return 1
                                }
                                return 0
                        }
                   }
                   return 1
         }
 }

 # sample usage ...
 package require Tk
 package require Ttk
 ttk::entry .e0 -width 14 -invalid bell \
        -validate key -validatecom [list de::Mapper {(999) 999-9999} %W %S %d]
 ttk::entry .e1 -width 14 -invalid bell \
        -validate key -validatecom [list de::Mapper {9999/99/99} %W %S %d]
 ttk::entry .e2 -width 14 -invalid bell \
        -validate key -validatecom [list de::Mapper {99:99:99} %W %S %d]
 pack .e0
 pack .e1
 pack .e2