package require Tk

 proc ikey {c language} {
    wm title . "iKey: $language"
    set keys $::ikey($language)
    set f {{Bitstream Cyberbit} 10 bold}
   #set x 7; set y 7
    set x 7; set y 9
    $c delete all
    foreach key [clist $keys] {
       $c create text $x $y -text $key -tag ikey \
          -font $f
       if [incr x 15]>220 {set x 7; incr y 15}
    }
    $c bind ikey <1> {
      %W itemconf current -fill red
      after 200 "%W itemconf current -fill black"
      set c [%W itemcget current -text]
      if {$c=="<"} {
          event generate . <BackSpace>
      } else {
         if {$c=="_"} {set c " "}
         catch {[focus] insert insert $c }
         if {$c>="\u05d0" && $c<="\u05ea"} {
            event generate . <Left>
         }
      }
    }
 }

 # This routine turns a compact character list, 
 # e.g. {a-d fx z} into a regular one: {a b c d f x z}.
 proc clist list {
    set res ""
    foreach item [lappend list "_,;.<"] {
        if [regexp {^(.)-(.)$} $item -> from to] {
          scan $to %c to
           for {set i [scan $from %c]} {$i<=$to} {incr i} {
              lappend res [format %c $i]
           }
        } else {
           foreach i [split $item ""] {lappend res $i }
        }
    }
    set res
 }
 array set ::ikey {
  Cyrillic {\u0410-\u044f}
  Greek    {1-9 0 - \u0391-\u03a1 \u03a3-\u03c9}
  Hebrew   {\u05d0-\u05ea}
  German1  {\u00c4 \u00d6 \u00dc \u00df  \u00e4 \u00f6 \u00fc \u20ac}
  German2  {1-9 0 # ! ? ' \u0022
            a-m + -   n-z * /
            A-M = %   N-Z \u003c >
            @ \u00c4 \u00d6 \u00dc \u00df  \u00e4 \u00f6 \u00fc 
            ~ [ \\ ] \u007b | \u007d
            ^ \u00b0 \u0060 \u00a7 &
            $ \u20ac \u00a3 () }
 }

 # As demo and self-test, here is a micro-app with an entry and a text, 
 # which have no function other than testing that focus is correct:
 if {[file tail [info script]]==[file tail $argv0]} {
    option add *Font {{Bitstream Cyberbit} 10}
    entry .e
  # text   .t -height 8 -width 1
  # canvas .c -width 240 -height  80 -bg yellow
    text   .t -height   6 -width   1
    canvas .c -height 110 -width 240 -bg yellow
    pack .e .t .c -fill x
    focus -force .t
    ikey .c Greek
    bind . <Return> {exec wish $argv0 &; exit}
    . config -menu [menu .m]
    .m add casc -label Language -menu [menu .m.l -tearoff 0]
    foreach i [array names ikey] {
      .m.l add comm -label $i -command "ikey .c $i"
    }
 }