set ::debug_keyboard true proc establishKeyPressListener {keyboard} { set kb [open $keyboard r] fconfigure $kb -translation binary return $kb } # Function to check if the device is a keyboard proc isKeyboard {device} { set properties [exec udevadm info --query=property --name=$device] if {$properties eq ""} { return false } set isKeyboard [string match *ID_INPUT_KEYBOARD=1* $properties] return $isKeyboard # TODO: Excluding mice would nice to keey the list of keyboard devices short # Alas, including mice is necessary for the Logitech K400R keyboard # set isMouse [string match *ID_INPUT_MOUSE=1* $properties] # return [expr {$isKeyboard && !$isMouse}] } #### # /dev/input/event* addresses are the ground truth for keyboard devices # # This function goes through each of them and checks if they are keyboards proc walkInputEventPaths {} { # set allDevices [glob -nocomplain "/dev/input/event*"] set allDevices [glob -nocomplain "/dev/input/by-path/*"] set keyboards [list] foreach device $allDevices { if {[isKeyboard $device]} { if {[file readable $device] == 0} { puts "Device $device is not readable. Attempting to change permissions." # Attempt to change permissions so that the file can be read exec sudo chmod +r $device } lappend keyboards $device } } return $keyboards } set keyboardDevices [walkInputEventPaths] set globalKeymap [keymap load "us"] # go through each keyboard device and start a process that foreach keyboard $keyboardDevices { Claim the keyboards are $keyboardDevices Start process "keyboard-$keyboard" { source "lib/Keymap.tcl" set KEY_STATES [list up down repeat] Wish $::thisProcess shares statements like \ [list keyboard /kb/ claims key /k/ is /t/ with timestamp /timestamp/] Wish $::thisProcess receives statements like \ [list /someone/ claims /page/ is a keyboard with path $keyboard locale /locale/] set ::localKeymap "" When $keyboardSpecifier is a keyboard with path $keyboard locale /locale/ { set ::localKeymap [keymap load $locale] On unmatch { keymap destroy $::localKeymap set ::localKeymap "" } } variable evtBytes 16 variable evtFormat iissi if {[exec getconf LONG_BIT] == 64} { set evtBytes 24 set evtFormat wwssi } set keyboardSpecifier $keyboard variable keyboardChannel [open $keyboard r] chan configure $keyboardChannel -translation binary set modifiers [dict map {k v} $keymap::modWeights 0] while 1 { binary scan [read $keyboardChannel $evtBytes] $evtFormat \ tvSec tvUsec type code value if {$type == 0x01} { ;# EV_KEY set activeKeymap [expr {$localKeymap eq "" ? $globalKeymap : $localKeymap}] set mods [+ {*}[dict values $modifiers]] set key [keymap resolve $activeKeymap $code $mods] if {$key eq ""} { continue } set keyState [lindex $KEY_STATES $value] set isDown [expr {$keyState != "up"}] if {[dict exists $keymap::modWeights $key]} { set weight [dict get $keymap::modWeights $key] dict set modifiers $key [expr {$isDown * $weight}] } set now [clock milliseconds] Assert keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $now puts "Assert keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $now" # Retract all key events that are more than 5 seconds old. set events [Statements::findMatches [list keyboard $keyboardSpecifier claims key /key/ is /keyState/ with timestamp /timestamp/]] foreach event $events { dict with event { if {$now - $timestamp > 5000} { Retract keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $timestamp } } } Step } } } }