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).

See Also

A little Korean editor

Description

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


Windows on screen keyboard

HaO 2022-07-06: One may open the on screen keyboard executable on Windows. This is tricky in particular, as on 64 bit Windows, the 64 bit version must be used (see [L1 ]).

Here is my code:

package require log
package require twapi
proc ScreenKeyboardShow {} {
    if {[catch {
        set WindowsFolder [twapi::get_shell_folder csidl_windows]
    } Err]} {
        ::log::logError "Error fetching Windows folder: $Err"
        set WindowsFolder {C:/Windows}
    }

    # Check for 64 bit OS
    if {$::tcl_platform(pointerSize) == 8} {
        set f64Bit 1
    } else {
        if {[catch { set f64Bit [twapi::wow64_process] } Err]} {
            ::log::logError "Error in TWAPI to check if on 64 bit OS: $Err"
            return
        }
    }

    if {$f64Bit} {
        if {[catch {
            set lFolders [glob -nocomplain\
                -path [file join $WindowsFolder "winsxs"\
                    "amd64_microsoft-windows-osk_"]\
                -types d *]
            foreach FolderCur $lFolders {
                set Path [file join $FolderCur osk.exe]
                if {[file exists $Path]} {
                    set OSKPath $Path
                    break
                }
            }
        } Err]} {
            ::log::logError "Error getting OSK path: $Err"
            return
        }
    } else {
        set OSKPath [file join $WindowsFolder system32\osk.exe]
    }
    if {[info exists OSKPath]} {
        if {[catch {
            exec -ignorestderr -- {*}[auto_execok start] $OSKPath
        } Err]} {
            ::log::logError "Error opening OSK: $Err, Path='$OSKPath'"
        }
    }
}

Thanks to the help on clt !