Keyboard widget

Richard Suchenwirth 1999-08-13:

This proc creates a frame and grids buttons into it for the specified character range (Unicodes welcome, but in 0x.. notation!). Each button bears its character as label, and inserts its character into the text widget specified with the -receiver option. This requires Tcl/Tk 8.1 or better and a font with the characters you want (of course).

Description edit

OPTIONS

-keys range: list of (decimal or hex Unicodes of) characters to display. Consecutive sequences may be written as range, e.g. {0x21-0x7E} gives the printable lower ASCII chars.
-keysperline n: number of keys per line, default: 16.
-title string: If not "", text of a title label displayed above the keys. Default: "".
-dir direction: if "r2l", moves cursor one to the left after each keypress. Useful for Arab/Hebrew. Default: l2r.
-receiver widgetpath: Name of a text widget to receive the keystrokes at its insert cursor.

EXAMPLE: a rudimentary editor for Cyrillic, in two lines: (see also A little Unicode editor)

   pack [text .t -width 80 -height 24]
   pack [keyboard .kbd -title Cyrillic -keys {0x410-0x44f} -receiver .t]

 proc keyboard {w args} {
   frame $w
   array set opts {
      -keys {0x21-0x7E} -title "" -keysperline 16 -dir l2r -receiver ""
   }
   array set opts $args ;# no errors checked 
   set klist {}; set n 0
   if {$opts(-title)!=""} {
      grid [label $w.title -text $opts(-title) ] \
               -sticky news -columnspan $opts(-keysperline)
      }
   foreach i [clist2list $opts(-keys)] {
      set c [format %c $i]
      set cmd "$opts(-receiver) insert insert [list $c]"
      if {$opts(-dir)=="r2l"} {
         append cmd ";$opts(-receiver) mark set insert {insert - 1 chars}"
      } ;# crude approach to right-to-left (Arabic, Hebrew) 
      button $w.k$i -text $c -command $cmd  -padx 5 -pady 0
      lappend klist $w.k$i
      if {[incr n]==$opts(-keysperline)} {
        eval grid $klist -sticky news
        set n 0; set klist {}
      }
    }
    if [llength $klist] {eval grid $klist -sticky news}
    set w ;# return widget pathname, as the others do
 }
 proc clist2list {clist} {
    #-- clist: compact integer list w.ranges, e.g. {1-5 7 9-11}
    set res {}
    foreach i $clist {
        if [regexp {([^-]+)-([^-]+)} $i -> from to] {
            for {set j [expr $from]} {$j<=[expr $to]} {incr j} {
                lappend res $j
            }
        } else {lappend res [expr $i]}
    }
    set res
 }

And here's some useful ranges if you happen to have the Cyberbit font:

 Arabic (context glyphs) {0xFE80-0xFEFC} r2l
 Cyrillic                {0x410-0x44f}
 Greek                   {0x386-0x38a 0x38c 0x38e-0x3a1 0x3a3-0x3ce}
 Hebrew                  {0x5d0-0x5ea 0x5f0-0x5f4}  r2l
 Hiragana                {0x3041-0x3094}
 Katakana                {0x30A1-0xU30FE}
 Thai                    {0xE01-0xE3A 0xE3F-0xE5B}

BUGS

It would be more straightforward to specify characters in the -keys argument literally, or in \uxxxx notation. But at home I still have 8.1a1 (blush) where Unicode scan don't work.

RS Update: I'm on 8.4 now for a while, and the latest evolution of the above code is at iKey: a tiny multilingual keyboard, which instead of buttons, has the characters directly clickable on a canvas, so it fits the small iPAQ screen.

George Petasis: Another virtual keyboard that has a slightly different orientation (it tries to mimic the operation of a usual keyboard) can be found here

Arts and crafts of Tcl-Tk programming

See Also edit

Description edit