1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
namespace eval keymap {
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 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 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;
}
}
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
}
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
}
set modWeights {
Shift 1
AltGr 2
Control 4
Alt 8
}
# @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 modWeights printable
namespace ensemble create
}
if {$::argv0 eq [info script]} {
set tkm [keymap load "it"]
# keymap dump $tkm
for {set i 0} {$i < 15} {incr i} {
puts "30/$i [keymap resolve $tkm 30 $i]"
}
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
}
|
