blob: 131a2898db7a2107e113a40a8c3c16dc42f18982 (
plain)
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
|
namespace eval keymap {
# Tcl implementation using loadkeys/dumpkeys
# needs debian packages: console-data
proc _fillRange {range} {
lassign [split $range -] from to
if {$to eq ""} {return $from}
set out [list]
for {set i $from} {$i <= $to} {incr i} {
lappend out $i
}
return $out
}
proc _parseKey {key} {
if {$key eq "VoidSymbol"} return
if {[string index $key 0] eq "+"} {
return [string range $key 1 end]
}
return $key
}
proc _parseUnicode {key} {
switch [string index $key 0] {
"U" {
set key 0x[string range $key 2 end]
if {!$key} return
}
"+" {
# map from KT_LETTER to KT_LATIN
set key [string range $key 1 end]
set key [expr {$key & 0xff}]
}
}
if {$key & 0xff00} return ;# only support KT_LATIN
if {$key < 32 || $key == 127} return ;# no control chars
return [format %c $key]
}
proc load {name} {
try {
exec kbd_mode -u $name
} on error e {
puts stderr "keymap: Warning: Could not do `kbd_mode -u $name`"
}
set keytable [exec dumpkeys -kf]
set unitable [exec dumpkeys -kfn]
set ksyms [dict create]
set mods [_fillRange 0-15]
foreach line [split $keytable "\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 modi 0
foreach key [lrange $line 3 end] {
set mod [lindex $mods $modi]
set str [_parseKey $key]
if {$str eq ""} continue
dict append ksyms "$code $mod" $str
incr modi
}
}
}
}
set chars [dict create]
set mods [_fillRange 0-15]
foreach line [split $unitable "\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 modi 0
foreach key [lrange $line 3 end] {
set mod [lindex $mods $modi]
set str [_parseUnicode $key]
if {$str eq ""} continue
dict append chars "$code $mod" $str
incr modi
}
}
}
}
return [list $ksyms $chars]
}
# takes km, keycode and mod-bitfield, returns [ksym char] tuple
# char is printable representation of ksym, or "" if unprintable
proc resolve {km code mod} {
lassign $km ksyms chars
set kk "$code $mod"
if {![dict exists $ksyms $kk]} return
return [list [dict get $ksyms $kk] [dict getdef $chars $kk ""]]
}
proc dump {km} {
lassign $km ksyms _
set range 0-15
puts "keymap $range"
set mods [_fillRange $range]
puts $ksyms
for {set code 1} {$code < 256} {incr code} {
set out [lmap mod $mods {dict getdef $ksyms "$code $mod" VoidSymbol}]
puts "keycode $code = [join $out \t]"
}
}
proc destroy {km} {} ;# for compatibility with C impl
namespace export load dump resolve destroy
variable modWeights {
Shift 1
AltGr 2
Control 4
Alt 8
}
namespace ensemble create
}
if {[info exists ::argv0] && $::argv0 eq [info script]} {
set tkm [keymap load "us"]
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]"
foreach code {5 12 27} {
puts "$code/0 [keymap resolve $tkm $code 0]"
}
keymap destroy $tkm
}
|
