diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Keymap.tcl | 306 | ||||
| -rw-r--r-- | lib/terminal.tcl | 7 |
2 files changed, 225 insertions, 88 deletions
diff --git a/lib/Keymap.tcl b/lib/Keymap.tcl index 92d737e2..29ce30c3 100644 --- a/lib/Keymap.tcl +++ b/lib/Keymap.tcl @@ -1,110 +1,246 @@ -source "lib/c.tcl" - namespace eval keymap { - rename [c create] kc - - kc include <stdio.h> - kc include <stdlib.h> - kc include <string.h> - kc include <keymap.h> - kc include <kbdfile.h> - kc include <linux/keyboard.h> - - kc code { - static const char *const dirpath[] = { - ".", - "/usr/lib/kbd/keymaps/**", - "/usr/share/kbd/keymaps/**", - NULL - }; - - static const char *const suffixes[] = { - "", - ".kmap", - ".map", - NULL - }; - - typedef struct lk_ctx lkctx_t; - } + try { + # C implementation based on libkeymap + # libkeymap is part of the kbd package, but most distros don't --enable-libkeymap + c loadlibLd libkeymap.so + c loadlibLd libkbdfile.so + + rename [c create] kc + + kc include <stdio.h> + kc include <stdlib.h> + kc include <string.h> + kc include <keymap.h> + kc include <kbdfile.h> + kc include <linux/keyboard.h> + + kc code { + static const char *const dirpath[] = { + ".", + "/usr/lib/kbd/keymaps/**", + "/usr/share/kbd/keymaps/**", + NULL + }; + + static const char *const suffixes[] = { + "", + ".kmap", + ".map", + NULL + }; + + typedef struct lk_ctx lkctx_t; + } - kc argtype lkctx_t* { - lkctx_t* $argname; sscanf(Tcl_GetString($obj), "(lkctx_t*) 0x%p", &$argname); - } + kc argtype lkctx_t* { + lkctx_t* $argname; sscanf(Tcl_GetString($obj), "(lkctx_t*) 0x%p", &$argname); + } - kc rtype lkctx_t* { - $robj = Tcl_ObjPrintf("(lkctx_t*) 0x%" PRIxPTR, (uintptr_t) $rvalue); - } + kc rtype lkctx_t* { + $robj = Tcl_ObjPrintf("(lkctx_t*) 0x%" PRIxPTR, (uintptr_t) $rvalue); + } - kc proc load {char* name} lkctx_t* { - lkctx_t* ctx = lk_init(); - // @TODO assert failures - struct kbdfile_ctx* fctx = kbdfile_context_new(); - struct kbdfile* file = kbdfile_new(fctx); - kbdfile_find(name, dirpath, suffixes, file); - lk_parse_keymap(ctx, file); - lk_add_constants(ctx); - kbdfile_close(file); - kbdfile_context_free(fctx); - return ctx; - } + kc proc load {char* name} lkctx_t* { + lkctx_t* ctx = lk_init(); + // @TODO assert failures + struct kbdfile_ctx* fctx = kbdfile_context_new(); + struct kbdfile* file = kbdfile_new(fctx); + kbdfile_find(name, dirpath, suffixes, file); + lk_parse_keymap(ctx, file); + lk_add_constants(ctx); + kbdfile_close(file); + kbdfile_context_free(fctx); + return ctx; + } - kc proc resolve {lkctx_t* ctx - int key - int mods} Tcl_Obj* { - if (!lk_map_exists(ctx, mods)) return Tcl_NewStringObj("", 0); - - // see https://github.com/legionus/kbd/blob/master/src/libkeymap/dump.c#L361-L395 - int code = lk_get_key(ctx, mods, key); - char* result; - - if (KTYP(code) == KT_LETTER) { - // this key should be affected by capslock, but do we care? - code = K(KT_LATIN, KVAL(code)); - result = lk_code_to_ksym(ctx, code); - } else if (KTYP(code) == KT_META && KVAL(code) < 128) { - code = K(KT_LATIN, KVAL(code)); - - char* base = lk_code_to_ksym(ctx, code); - asprintf(&result, "Meta_%s", base); - free(base); - } else { - result = lk_code_to_ksym(ctx, code); + kc proc resolve {lkctx_t* ctx + int key + int mods} Tcl_Obj* { + if (!lk_map_exists(ctx, mods)) return Tcl_NewStringObj("", 0); + + // see https://github.com/legionus/kbd/blob/master/src/libkeymap/dump.c#L361-L395 + int code = lk_get_key(ctx, mods, key); + char* result; + + if (KTYP(code) == KT_LETTER) { + // this key should be affected by capslock, but do we care? + code = K(KT_LATIN, KVAL(code)); + result = lk_code_to_ksym(ctx, code); + } else if (KTYP(code) == KT_META && KVAL(code) < 128) { + code = K(KT_LATIN, KVAL(code)); + + char* base = lk_code_to_ksym(ctx, code); + asprintf(&result, "Meta_%s", base); + free(base); + } else { + result = lk_code_to_ksym(ctx, code); + } + + if (result == NULL) { + return Tcl_NewStringObj("", 0); + } else { + Tcl_Obj* tclres = Tcl_NewStringObj(result, -1); + free(result); + return tclres; + } } - if (result == NULL) { - return Tcl_NewStringObj("", 0); - } else { - Tcl_Obj* tclres = Tcl_NewStringObj(result, -1); - free(result); - return tclres; + kc proc dump {lkctx_t* ctx} void { + lk_dump_keymaps(ctx, stdout); + lk_dump_keys(ctx, stdout, LK_SHAPE_FULL_TABLE, 0); + } + + kc proc destroy {lkctx_t* ctx} void { + lk_free(ctx); + } + + kc compile + + namespace export * + } on error e { + # Tcl implementation using loadkeys/dumpkeys + proc _fillRange {range} { + lassign [split $range -] from to + if {$to eq ""} {return $from} + + set out "" + for {set i $from} {$i <= $to} {incr i} { + lappend out $i + } + return $out } - } - kc proc dump {lkctx_t* ctx} void { - lk_dump_keymaps(ctx, stdout); - lk_dump_keys(ctx, stdout, LK_SHAPE_FULL_TABLE, 0); + proc _parseKey {key} { + if {$key eq "nul"} {return ""} + + if {[string index $key 0] eq "+"} { + return [string range $key 1 end] + } + + return $key + } + + proc _unparseKey {key} { + if {$key eq ""} {return "nul"} + + if {[string length $key] == 1} { + return "+$key" + } + + return $key + } + + proc load {name} { + if {$::isLaptop} { + exec sudo loadkeys -C /dev/tty0 $name + set table [exec sudo dumpkeys -C /dev/tty0 -kf] + set extraArgs {-C /dev/tty0} + } else { + exec loadkeys $name + set table [exec dumpkeys -kf] + } + + set mods [_fillRange 0-15] + set codes "" + + foreach line [split $table "\n"] { + switch [lindex $line 0] { + keymaps { + set map [split [lindex $line 1] ,] + set mods [concat {*}[lmap r $map {_fillRange $r}]] + } + + keycode { + set code [lindex $line 1] + set keys [lrange $line 3 end] + set keys [lmap k $keys {_parseKey $k}] + dict append codes $code $keys + } + } + } + + return [list $mods $codes] + } + + proc dump {km} { + lassign $km mods codes + puts "keymap [join $mods ,]" + dict fir {code keys} $codes { + set keys [lmap k $keys {_unparseKey $k}] + puts "keycode $code = [join $keys \t]" + } + } + + proc resolve {km code mod} { + # @TODO: error/range handling + lassign $km mods codes + set mod [lsearch -exact $mods $mod] + return [lindex [dict get $codes $code] $mod] + } + + proc destroy {km} {} ;# for compatibility with C impl + namespace export load dump resolve destroy } - kc proc free_km {lkctx_t* ctx} void { - lk_free(ctx); + set modWeights { + Shift 1 + AltGr 2 + Control 4 + Alt 8 } - c loadlibLd libkeymap.so - c loadlibLd libkbdfile.so - kc compile + # @TODO: complete this table or find a better data source + # https://wiki.linuxquestions.org/wiki/List_of_keysyms + set remapTable { + one 1 + two 2 + three 3 + four 4 + five 5 + six 6 + seven 7 + eight 8 + nine 9 + zero 0 + apostrophe ' + igrave ` + space " " + exclam ! + quotedbl \" + sterlin ??? + dollar \$ + percent % + ampersand & + slash / + parenleft ( + parenright ) + equal = + question ? + asciicircum ^ + numbersign # + plus + + minus - + underscore _ + } + proc printable {keysym} { + variable remapTable + if {![string is lower $keysym]} {return ""} + return [dict_getdef $remapTable $keysym $keysym] + } - namespace export * + namespace export modWeights printable namespace ensemble create } if {$::argv0 eq [info script]} { set tkm [keymap load "it"] - keymap dump $tkm + # keymap dump $tkm for {set i 0} {$i < 15} {incr i} { puts "30/$i [keymap resolve $tkm 30 $i]" } - keymap free_km $tkm + puts "252/0 [keymap resolve $tkm 252 0]" + puts [join [lmap code {5 12 27} {keymap printable [keymap resolve $tkm $code 0]}] ""] + keymap destroy $tkm } diff --git a/lib/terminal.tcl b/lib/terminal.tcl index 2ab8dd2d..164cdfd6 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -17,7 +17,8 @@ namespace eval Terminal { LEFT "\x1b\[D" \ ] - proc _remap {key ctrlPressed} { + proc _remap {key} { + # @TODO: this doesn't take ctrlPressed anymore variable keymap if {[string length $key] == 1} { # Convert ctrl-A through ctrl-Z and others to terminal control characters @@ -46,8 +47,8 @@ namespace eval Terminal { } # Writes a keyboard key to the terminal, handling control codes - proc write {term key ctrlPressed} { - set key [_remap $key $ctrlPressed] + proc write {term key} { + set key [_remap $key] if {[string length $key] > 0} { termWrite $term $key } |