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