#!/bin/sh
 # use -*-Tcl-*- \
 exec wish "$0"

 proc keyboard {w args} {
    destroy $w
    frame $w
    array set opts {-keys {0xA0-0xFF} -keysperline 16}
    array set opts $args ;# no errors checked
    set klist {}; set n 0
    foreach i [clist2list $opts(-keys)] {
        set c [format %c $i]
        set cmd "$opts(-receiver) insert insert [list $c]"
        if {$i>=0x5D0 && $i<=0x6FF} {
            append cmd ";$opts(-receiver) mark set insert {insert - 1 chars}"
        }
        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}
    pack $w -side bottom
    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
 }
 proc file:open {w} {
    set fn [tk_getOpenFile]
    if [string length $fn] {
        $w delete 1.0 end
        set f [open $fn]
        fconfigure $f -encoding $::Encoding
        regsub -all \uFEFF [read $f [file size $fn]] "" text
        foreach line [split $text \n] {
            $w insert end $line\n
        }
        close $f
    }
 }
 proc file:save {w} {
    set fn [tk_getSaveFile]
    if [string length $fn] {
        set f [open $fn w]
        fconfigure $f -encoding $::Encoding
        if {$::Encoding=="unicode"} {
            puts -nonewline $f \uFEFF
        }
        puts -nonewline $f [$w get 1.0 end-2c]
        close $f
    }
 }
 ##################################################################### #
 menu .menu
 . config -menu .menu

 menu .menu.file -tearoff 0
 .menu add cascade -label File -menu .menu.file
 .menu.file add command -label Open... -command {file:open .t}
 .menu.file add command -label Save... -command {file:save .t}
 .menu.file add separator
 .menu.file add command -label Exit -command exit

 menu .menu.enc -tearoff 0
 .menu add cascade -label Encoding -menu .menu.enc
 foreach i {
    ascii cp1252 euc-jp iso2022-jp iso8859-1 iso8859-2 iso8859-3
    iso8859-4 iso8859-5 iso8859-6 iso8859-7 iso8859-8
    jis0208 koi8-r shiftjis utf-8 unicode
 } {
   .menu.enc add radio -label $i -variable ::Encoding -value $i
 }
 set ::Encoding [encoding system]

 menu .menu.lang -tearoff 0
 .menu add cascade -label Language -menu .menu.lang
 foreach {lang range} {
    "Euro Latin 1"          {0xA0-0xFF}
    Arabic                  {0xFE80-0xFEFC}
    Cyrillic                {0x410-0x44f}
    Greek                   {0x386-0x38a 0x38c 0x38e-0x3a1 0x3a3-0x3ce}
    Hebrew                  {0x5d0-0x5ea 0x5f0-0x5f4}
    Hiragana                {0x3041-0x3094}
    Katakana                {0x30A1-0x30FE}
    Thai                    {0xE01-0xE3A 0xE3F-0xE5B}
 } {
    .menu.lang add command -label $lang -command \
            [list keyboard .kbd -keys $range -receiver .t]
 }

 keyboard .kbd -receiver .t
 pack [text .t -width 80 -height 24] -fill both -expand 1
 focus .t