From c9c5a17aaafbc1eed95592b0a204316ab202ebb4 Mon Sep 17 00:00:00 2001
From: Ralph Ronnquist <rrq@rrq.au>
Date: Sun, 16 Mar 2025 01:44:21 +1100
Subject: [PATCH] added utility for key event propagation control

---
 keystop.lsp | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 130 insertions(+)
 create mode 100755 keystop.lsp

diff --git a/keystop.lsp b/keystop.lsp
new file mode 100755
index 0000000..5223f05
--- /dev/null
+++ b/keystop.lsp
@@ -0,0 +1,130 @@
+#!/usr/bin/newlisp
+# Copyright 2025, Ralph Ronnquist <rrq@rrq.au>
+
+; This newlisp script is a "daemon" to make given window a stop window
+; for key press/release events, by registering interest in thses
+; events with a do-not-propagate mask set.
+;
+; https://tronche.com/gui/x/xlib/
+; http://refspecs.linuxfoundation.org/LSB_3.1.1/LSB-Desktop-generic/LSB-Desktop-generic/libx11-ddefs.html
+; https://specifications.freedesktop.org/wm-spec/1.3/index.html
+; https://www.x.org/archive/X11R7.7/doc/man/man3/Xinerama.3.xhtml
+
+; Set up to die on ^C
+(define (die x) (exit 0)) (signal 2 die)
+
+; Utility to return the first of a series of terms.
+(define (prog1) (args 0))
+
+; Read macro for the address at a byte offset <N> into block <P>.
+(macro (p@ P N) (+ (address P) N))
+
+; Utility to unpack a packed binary array at <p> of <n> layout <s>
+; records with <w> fields each.
+(define (unpack-array s w n p) (explode (unpack (dup s n) p) w))
+
+; Making them available in all contexts.
+(global 'prog1 'p@ 'unpack-array)
+
+(context 'MAIN:X11) ; API for libX11.so
+(constant 'LIB "/usr/lib/x86_64-linux-gnu/libX11.so") ; Devuan 2.0
+
+(import LIB "XDefaultRootWindow" "void*"
+        "void*" ; display
+        )
+
+(import LIB "XFree" "void"
+        "void*" ; data
+        )
+
+(import LIB "XOpenDisplay" "void*"
+        "void*" ; display
+        )
+
+(import LIB "XQueryTree" "int"
+        "void*" "void*" ; display, window
+        "void*" "void*" ; root_return, parent_return
+        "void*" "void*" ; children_return, nchildren_return
+        )
+
+(import LIB "XGetWindowAttributes" "int"
+        "void*" "long" "void*" ; *display, w, *window_attributes_return;
+        )
+
+(import LIB "XChangeWindowAttributes" "int"
+        "void*" "long" ; display, window
+        "long" "void*" ; value mask, attributes
+)
+
+(struct 'XQueryTree_return
+        "long" "long" ; root_return, parent_return
+        "long" "int" ; children_return, nchildren_return
+        )
+
+(struct 'XWindowAttributes
+	"int" "int" "int" "int" ; x, y, width, height
+	"int" "int" ; border_width, depth
+        "void*" "long" ; *visual, root
+	"int" "int" "int" "int" ; class,bit_gravity,win_gravity,backing_store
+        "long" "long" "int" ; backing_planes, backing_pixel, save_under
+	"long" "int" "int" ; colormap, map_installed, map_state;
+	"long" "long" ; all_event_masks, your_event_mask
+        "long" "int" ; do_not_propagate_mask, override_redirect
+	"void*" ; *screen
+        )
+
+(struct 'XSetWindowAttributes
+       	"long" "long" ; Pixmap background_pixmap, background_pixel
+	"long" "long" ; Pixmap border_pixmap, border_pixel
+	"int" "int" "int" ; bit_gravity, win_gravity, backing_store
+	"long" "long" ; backing_planes, backing_pixel
+	"int" "long" "long" ; save_under, event_mask, do_not_propagate_mask
+	"int" "long" "long" ; override_redirect colormap, cursor
+        )
+
+; Initializing the X client, and defining some constants.
+(constant
+ 'display (XOpenDisplay 0)
+ 'root (XDefaultRootWindow display)
+ 'KeyPressMask           (<< 1 0)
+ 'KeyReleaseMask	 (<< 1 1)
+ 'CWDontPropagate         (<< 1 12)
+ )
+
+(define (stop-propagate WINDOW)
+  (let ((OLD (pack XWindowAttributes (dup 0 23))) (ATTR nil) (CUR nil))
+    (XGetWindowAttributes display WINDOW (address OLD))
+    (setf CUR (unpack XWindowAttributes OLD))
+    (setf CUR (| (CUR -2) KeyPressMask KeyReleaseMask))
+    (setf ATTR (pack XSetWindowAttributes
+                     (list 0 0 0 0 0 0 0 0 0 0 0 CUR 0 0 0)))
+    (XChangeWindowAttributes display WINDOW CWDontPropagate ATTR)))
+
+(define (start-propagate WINDOW)
+  (let ((OLD (pack XWindowAttributes (dup 0 23))) (ATTR nil) (CUR nil))
+    (XGetWindowAttributes display WINDOW (address OLD))
+    (setf CUR (unpack XWindowAttributes OLD))
+    (setf CUR (& (CUR -2) (~ KeyPressMask) (~ KeyReleaseMask)))
+    (setf ATTR (pack XSetWindowAttributes
+                     (list 0 0 0 0 0 0 0 0 0 0 0 CUR 0 0 0)))
+    (XChangeWindowAttributes display WINDOW CWDontPropagate ATTR)))
+
+(define (children w)
+  (let ((r (pack XQueryTree_return 0 0 0 0)))
+    (when (!= (XQueryTree display w (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24)))
+      (setf r (unpack XQueryTree_return r))
+      (prog1 (if (!= (r 3)) (map first (unpack-array "Lu" 1 (r 3) (r 2))))
+        (XFree (r 2))))))
+
+(define (windows W)
+  (cons W (map windows (or (children W) '()))))
+
+(context MAIN) ; ---- The main application starts here ----
+
+(setf WINDOW (int (main-args -2) 0 16) FLAG (= (int (main-args -1) 0 2)))
+
+; Needs to be done twice (not sure why?)
+(if FLAG (X11:start-propagate WINDOW) (X11:stop-propagate WINDOW))
+(if FLAG (X11:start-propagate WINDOW) (X11:stop-propagate WINDOW))
+
+(exit)
-- 
2.39.5