package require Tk

 # Paint the keys for choosen language onto the canvas:
 proc ikey {c language} {
    wm title . "iKey: $language"
    set keys $::ikey($language)
    set f {{Bitstream Cyberbit} 10 bold}
    set x 10; set y 10
    $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 10; 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]
      catch {[focus] insert insert $c }
      if {$c>="\u05d0" && $c<="\u05ea"} {  # l2r
         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}
  Georgian {\u10D0-\u10D6 \u10f1
            \u10D7-\u10DC \u10f2
            \u10DD-\u10E2 \u10f3
            \u10E3 \u10f7
            \u10E4-\u10E7 \u10f8
            \u10E8-\u10EE \u10f4
            \u10EF \u10f0 \u10f5 \u10f6
           }
  Hebrew   {\u05d0-\u05ea}
  French   {\u20ac 
            \u00C0\u00E0 \u00C2\u00E2 \u00C6\u00E6 \u00C4\u00E4
            \u00C7\u00E7
            \u00C8\u00E8 \u00C9\u00E9 \u00CA\u00EA \u00CB\u00EB
            \u00CE\u00EE \u00CF\u00EF  \u00F1
            \u00D4\u00F4 \u0152\u0153 \u00D6\u00F6
            \u00D9\u00F9 \u00DB\u00FB \u00DC\u00FC
            \u00FF\u0178  \u00AB \u00BB
            }

  German1   {@ \u00c4 \u00d6 \u00dc \u00df  \u00e4 \u00f6 \u00fc \u00a7 \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 \u00B5 &
             $ \u20ac \u00a3 ()  
             }
  Nordic     {\u00C6\u00E6 \u00D8\u00F8 \u00C5\u00E5
              \u00C4\u00E4 \u00D6\u00F6 \u20ac
             }
  Ogham      {\u1681-\u169a  \u169b \u1680 \u169c}
  
  Spanish    {\u20ac \u00D1\u00F1  
              \u00C1\u00E1\u00C9\u00E9\u00CD\u00ED\u00D3\u00F3\u00DA\u00FA
              \u00BF\u00A1
             }
  Lao        {\u0E81\u0E82 \u0E84 \u0E87\u0E88 \u0E8A \u0E8D
              \u0E94-\u0E97 \u0E99-\u0E9F
              \u0EA1-\u0EA3 \u0EA5 \u0EA7 \u0EAA\u0EAB \u0EAD-\u0EAF
              \u0EB0-\u0EB9 \u0EBB-\u0EBD
              \u0EC0-\u0EC4 \u0EC6 \u0EC8-\u0ECD
              \u0ED0-\u0ED9 \u0EDc-\u0EDd
             }
  Thai       {\uE01-\uE3A \uE3F-\uE5B}
  Turkish    {\u20ac 
              \u00C4\u00E4
              \u00C7\u00E7
              \u011E\u011F
              \u0130\u0131

              \u00D1\u00F1
              \u00D6\u00F6
              \u015E\u015F
              \u00DC\u00FC              
              \u00C2 \u00CA \u00CE \u00D4 \u00Db
              \u00E2 \u00EA \u00EE \u00F4 \u00FB
             }

  _Brackets  {# ' \u0022 \u0060
              + - * / % = < > @ & ~
              ^ $ () [ \\ ] \u007b | \u007d :
              ! ? \u0009
             }
  _Fractions {\u00BC\u00BD\u00BE  \u2153\u2154  \u2155\u2156\u2157\u2158
              \u2159\u215A  \u215B\u215C\u215D\u215E 
              \u215F ( ) + - * / = < >
             }

 }

 ###

 # Move cursor to top or end of text:
 proc goTopEnd {} {
     if {[.t index insert] == 1.0} {set p end} else {set p 1.0}
     .t mark set insert $p
     .t see insert
 }

 proc show {ln tx} {
     .t insert insert "$ln: \t$tx\n"
     .t see end
 }
 proc demo1 {} {
     show French        "R\u00F4ti de b\u0153uf \u00E0 la po\u00EAle"; # Rôti de bœuf à la poêle
     show German        "R\u00FCcksto\u00DFd\u00E4mpfer\u00F6l";  # Rückstoßdämpferöl
     show Nordic        "Hyv\u00E4\u00E4 y\u00F6t\u00E4";         # FI: Hyvää yötä
     show Spanish       "\u00BFQu\u00E9 hay de nuevo?";           # ¿Qué hay de nuevo?
     show Turkish       "T\u00FCrk\u00E7e";                       # Türkçe
 }
 proc demo2 {} {
     show Cyrillic        "\u0420\u0443\u0441\u0441\u043A\u0438\u0439";  # Русский
     show Georgian        "\u10E5\u10D0\u10E0\u10D7\u10E3\u10DA\u10D8";
     show Greek           "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AC"; # Ελληνικά
     show Hebrew          "\u05E2\u05D1\u05E8\u05D9\u05EA"
     show Lao             "\u0EA5\u0EB2\u0EA7";
     show Thai            "\u0E44\u0E17\u0E22";
 }
 proc demo3 {} {   # ....+....1....+....2....+....3....+....4
     show Brackets        {awk '{sub(/[ \t]+$/,"")}; 1'};  # delete trailing whitespace
     show Fractions       "\u00BD+\u2153=\u215A";  # 1/2 + 1/3 = 3/6+2/6 = 5/6
     show Ogham           "\u169B\u1680\u1681\u1687\u168D\u1693\u1695\u1696\u1697\u1698\u1699\u169A\u169C"
 }

 ###

 # 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   6 -width   1
    canvas .c -height 110 -width 240 -bg yellow
    pack   .e .t .c -fill x
    focus -force .t
  # ikey .c Greek
    ikey .c German2
  ##bind . <Return> {exec wish $argv0 &; exit}
    . config -menu [menu .m]
    .m add casc -label Language -menu [menu .m.l -tearoff 0]
    foreach i [lsort [array names ikey] ]  {
      .m.l add comm -label $i -command "ikey .c $i"
    }
    .m add command -label "_"    -command {.t insert insert " "}
    .m add command -label "v"    -command {.t insert insert "\n"; .t see insert}
    .m add command -label "<"    -command "event generate . <BackSpace>"

  # .m add separator
  ##.m add command   -label "   " -state   disabled
  ##.m add command   -label "^v"  -command goTopEnd
  ##.m add command   -label "   " -state   disabled
    .m add command   -label "  ^v  "  -command goTopEnd

    .m add cascade   -label "!" -menu [menu .m.! -tearoff 0]
    .m.! add command -label Demo1 -command demo1
    .m.! add command -label Demo2 -command demo2
    .m.! add command -label Demo3 -command demo3

    set msgA "iKey: a tiny\nmultilingual keyboard\n\
            by\nRichard Suchenwirth,\n2002-02\n\
            and\nHaJo Gurt,\n2014-09"
    set msgH "Language: choose alphabet\n\
            _  insert space\n\
            v  insert new line\n\
            <  backspace\n\
            ^v move cursor to start-\n\
           \   or end-of-text\n\
            !  insert demo-text\n"
    .m add command -label "?"  -command {tk_messageBox -title "About"     -message $msgA}    
    .m add command -label "??" -command {tk_messageBox -title "iKey Help" -message $msgH}
 }

#.