Grab keyboard devices while associated to a pagekeymap-locale

3 files changed, 60 insertions, 45 deletions

diff --git a/lib/language.tcl b/lib/language.tcl
index 2977933d..bb42a800 100644
--- a/lib/language.tcl
+++ b/lib/language.tcl
@@ -18,13 +18,14 @@ proc unknown {name args} {
 }
 
 namespace eval dictset {
-    namespace export create add union difference entries size
+    namespace export create add remove union difference entries size
     proc create {args} {
         set kvs [list]
         foreach k $args { lappend kvs $k true }
         dict create {*}$kvs
     }
     proc add {sv entry} { upvar $sv s; dict set s $entry true }
+    proc remove {sv entry} { upvar $sv s; dict unset s $entry }
 
     proc union {s t} { dict merge $s $t }
     proc difference {s t} {
diff --git a/virtual-programs/editor.folk b/virtual-programs/editor.folk
index a5ebbfdd..b5d06d7c 100644
--- a/virtual-programs/editor.folk
+++ b/virtual-programs/editor.folk
@@ -3,11 +3,11 @@ set baseCode "Wish \$this is outlined green"
 # This makes all keyboards into editors automatically, so a keyboard
 # doesn't need an extra printed claim to be an editor. May choose to
 # change later, or exclude keyboards that opt out.
-When /page/ is a keyboard with path /anything/ {
+When /page/ is a keyboard with path /...anything/ {
     Claim $page is an editor
 }
 
-When /page/ is a keyboard with path /kbPath/ &\
+When /page/ is a keyboard with path /kbPath/ /...anything/ &\
   /page/ is an editor &\
   /page/ has region /r/ &\
   the clock time is /t/ {
@@ -27,7 +27,7 @@ When /page/ is a keyboard with path /kbPath/ &\
   }
 }
 
-When /page/ is a keyboard with path /kbPath/ {
+When /page/ is a keyboard with path /kbPath/ /...anything/ {
   On unmatch {
     Commit "time$kbPath" {}
   }
@@ -48,7 +48,7 @@ proc updateCursor {oldCursor updates} {
 proc x {vector} { lindex $vector 0 }
 proc y {vector} { lindex $vector 1 }
 
-When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
+When /page/ is a keyboard with path /kbPath/ /...anything/ & /page/ is an editor {
   set id "$page$kbPath"
   When /nobody/ claims $id has program code /c/ {
     Commit "cursor$kbPath" {
@@ -138,7 +138,7 @@ proc debug {position color} {
   Display::circle {*}$position 5 2 $color true
 }
 
-When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
+When /page/ is a keyboard with path /kbPath/ /...anything/ & /page/ is an editor {
   set id "$page$kbPath"
   When $id has program code /code/ & $id has editor code /editorCode/ & the clock time is /t/ & the $kbPath cursor is /cursor/ & $id has region /r/ {
     set intTime [expr {int($t * 10)}]
@@ -189,7 +189,7 @@ proc getCurrentLineLength {lines cursor} {
   string length $currentLine
 }
 
-When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
+When /page/ is a keyboard with path /kbPath/ /...anything/ & /page/ is an editor {
   set id "$page$kbPath"
 
   Every time keyboard $kbPath claims key /key/ is /keyState/ with /...options/ &\
@@ -366,6 +366,6 @@ When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
 
 Claim $this has demo {
   # Find your keyboard path with the script in this guide: https://folk.computer/guides/keyboard
-  Claim $this is a keyboard with path /dev/input/by-path/pci-0000:02:00.0-usb-0:2:1.2-event-mouse
+  Claim $this is a keyboard with path /dev/input/by-path/pci-0000:02:00.0-usb-0:2:1.2-event-mouse locale us
   Claim $this is an editor
 }
diff --git a/virtual-programs/keyboard.folk b/virtual-programs/keyboard.folk
index 3faba7cd..60b486f8 100644
--- a/virtual-programs/keyboard.folk
+++ b/virtual-programs/keyboard.folk
@@ -1,12 +1,3 @@
-set ::debug_keyboard true
-source "lib/keymap.tcl"
-
-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]
@@ -43,36 +34,57 @@ proc walkInputEventPaths {} {
 }
 
 set keyboardDevices [walkInputEventPaths]
-set globalKeymap [keymap load "us"]
 
-When /page/ is a keyboard with path /keyboard/ locale /locale/ {
-    Claim $page is a keyboard with path $keyboard
+Claim the keyboards are $keyboardDevices
+
+# backwards compatibility
+When /page/ is a keyboard with path /keyboard/ {
+    Claim $page is a keyboard with path $keyboard locale 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 cc [c create]
+        $cc include <linux/input.h>
+        $cc include <sys/ioctl.h>
+        $cc include <stdio.h>
+        $cc include <string.h>
+
+        $cc proc ::setGrabDevice {Tcl_Interp* interp char* channelName bool grab} void {
+            FILE* fp;
+            if (Tcl_GetOpenFile(interp, channelName, 0, 1, (ClientData *) &fp) != TCL_OK) {
+                printf("unable to open channel '%s' as file\n'", channelName);
+                return;
+            }
+            ioctl(fileno(fp), EVIOCGRAB, (void*)grab);
+        }
+        $cc compile
+
         set KEY_STATES [list up down repeat]
 
+        variable ::keyboardChannel [open $keyboard r]
+        chan configure $::keyboardChannel -translation binary
+
         Wish $::thisProcess shares statements like \
             [list keyboard /kb/ claims key /k/ is /t/ with /...options/]
         Wish $::thisProcess receives statements like \
             [list /someone/ claims /page/ is a keyboard with path $keyboard locale /locale/]
 
-        set ::localKeymap ""
+        set ::localKeymaps [dictset create]
         When /page/ is a keyboard with path $keyboard locale /locale/ {
-            if {$::localKeymap ne ""} {keymap destroy $::localKeymap}
-            set ::localKeymap [keymap load $locale]
-            # @TODO: this races different locale on change
-            # On unmatch {
-            #     puts "KEYB LOCALE RESET"
-            #     keymap destroy $::localKeymap
-            #     set ::localKeymap ""
-            # }
+            set map [keymap load $locale]
+            dictset add ::localKeymaps $map
+            ::setGrabDevice $::keyboardChannel [dictset size $::localKeymaps]
+
+            On unmatch {
+                dictset remove ::localKeymaps $map
+                keymap destroy $map
+                ::setGrabDevice $::keyboardChannel [dictset size $::localKeymaps]
+            }
         }
-
         Step
 
         variable evtBytes 16
@@ -82,21 +94,23 @@ foreach keyboard $keyboardDevices {
             set evtFormat wwssi
         }
 
-        variable keyboardChannel [open $keyboard r]
-        chan configure $keyboardChannel -translation binary
-
         set modifiers [dict map {k v} $keymap::modWeights {set v 0}]
         while 1 {
-            binary scan [read $keyboardChannel $evtBytes] $evtFormat \
+            binary scan [read $::keyboardChannel $evtBytes] $evtFormat \
                 tvSec tvUsec type code value
 
             if {$type == 0x01} { ;# EV_KEY
                 Step
 
-                set activeKeymap [expr {$::localKeymap eq "" ? $globalKeymap : $::localKeymap}]
-                set mods [+ {*}[dict values $modifiers]]
-                lassign [keymap resolve $activeKeymap $code $mods] key keychar
-                if {$key eq ""} { continue }
+                lassign [dictset entries $::localKeymaps] activeKeymap
+                if {$activeKeymap ne ""} {
+                    set mods [+ {*}[dict values $modifiers]]
+                    lassign [keymap resolve $activeKeymap $code $mods] key keychar
+                    if {$key eq ""} { continue }
+                } else {
+                    set key Unknown_$code
+                    set keychar "."
+                }
 
                 set keyState [lindex $KEY_STATES $value]
 
@@ -107,14 +121,15 @@ foreach keyboard $keyboardDevices {
                 }
 
                 set now [clock milliseconds]
-                if {$keychar eq ""} {
-                    Assert keyboard $keyboard claims key $key is $keyState with timestamp $now
-                } else {
-                    Assert keyboard $keyboard claims key $key is $keyState with timestamp $now printable $keychar
+                set options [dict create timestamp $now]
+                if {$keychar ne ""} {
+                    dict set options printable $keychar
                 }
+                Assert keyboard $keyboard claims key $key is $keyState with {*}$options
 
                 # Retract all key events that are more than 5 seconds old.
-                set events [Statements::findMatches [list keyboard $keyboard claims key /key/ is /keyState/ with /...options/]]
+                set events [Statements::findMatches \
+                    [list keyboard $keyboard claims key /key/ is /keyState/ with /...options/]]
                 foreach event $events {
                     dict with event {
                         set timestamp [dict get $options timestamp]
@@ -124,7 +139,6 @@ foreach keyboard $keyboardDevices {
                     }
                 }
 
-
                 Step
             }
         }