change the way input is handled

No longer call grab-keyboard when stumpwm wants to read input. When a
top level key is pressed, the keyboard is frozen. When a key is to be
read the keyboard is unfrozen for 1 keystroke and then refrozen. When
the key press event has been handled, stumpwm unfreezes the keyboard.

I still don't understand why C-t ; reload lets you type in the focused
window. The keyboard should be frozen at this point.

core.lisp

@@ -2394,9 +2394,10 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
                                              :border-width 1
                                              :colormap (xlib:screen-default-colormap
                                                         screen-number)
-                                             :event-mask '(:key-press)))
+                                             :event-mask '(:key-press :key-release)))
            (focus-window (xlib:create-window :parent (xlib:screen-root screen-number)
-                                             :x 0 :y 0 :width 1 :height 1))
+                                             :x 0 :y 0 :width 1 :height 1
+                                             :event-mask '(:key-press :key-release)))
            (message-window (xlib:create-window :parent (xlib:screen-root screen-number)
                                                :x 0 :y 0 :width 1 :height 1
                                                :background bg
@@ -2414,7 +2415,6 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
       ;; Create our screen structure
       ;; The focus window is mapped at all times
       (xlib:map-window focus-window)
-      (xwin-grab-keys focus-window)
       (setf (screen-number screen) screen-number
             (screen-id screen) id
             (screen-host screen) host
@@ -2893,7 +2893,9 @@ list of modifier symbols."
 
 (defun read-from-keymap (kmap &optional update-fn)
   "Read a sequence of keys from the user, guided by the keymap,
-KMAP and return the binding or nil if the user hit an unbound sequence."
+KMAP and return the binding or nil if the user hit an unbound sequence.
+
+The Caller is responsible for setting up the input focus."
   (let* ((code-state (read-key-no-modifiers))
          (code (car code-state))
          (state (cdr code-state)))
@@ -2925,46 +2927,34 @@ KMAP and return the binding or nil if the user hit an unbound sequence."
                       (boundp cmd)
                       (hash-table-p (symbol-value cmd))))
              (when grab
-               (grab-pointer (current-screen))
-               ;;              (grab-keyboard (current-screen))
-               )
+               (grab-pointer (current-screen)))
              (let* ((code-state (read-key-no-modifiers))
                     (code (car code-state))
                     (state (cdr code-state)))
-               (handle-keymap cmd code state key-seq nil update-fn)))
+               (unwind-protect
+                    (handle-keymap cmd code state key-seq nil update-fn)
+                 (when grab (ungrab-pointer)))))
             (t (values cmd key-seq)))
           (if (equalp key (kbd "?"))
               (progn (display-keybinding keymap) (values t key-seq))
               (values nil key-seq))))))
 
 (define-stump-event-handler :key-press (code state #|window|#)
-  ;; modifiers can sneak in with a race condition. so avoid that.
-  (unless (is-modifier (xlib:keycode->keysym *display* code 0))
-    ;; grab the keyboard so all keys are sent to us, then thraw the
-    ;; keyboard so we get events.
-    (grab-keyboard (current-screen))
-    (xlib:allow-events *display* :async-keyboard)
-    ;; make absolutely sure we give back the keyboard
+  (labels ((get-cmd (code state)
+             (with-focus (screen-focus-window (current-screen))
+               (handle-keymap *top-map* code state nil t nil))))
     (unwind-protect
-         (labels ((get-cmd (code state)
-                    (unwind-protect
-                         (progn
-                           (handle-keymap *top-map* code state nil t nil))
-                      (ungrab-pointer)
-                      ;; This must be here and not after the command
-                      ;; has run because firefox doesn't accept fake
-                      ;; C-t keys otherwise. Presumably this is
-                      ;; because it detects the keyboard has been
-                      ;; grabbed and ignores all key events until it's
-                      ;; ungrabbed.
-                      (ungrab-keyboard))))
+         ;; modifiers can sneak in with a race condition. so avoid that.
+         (unless (is-modifier (xlib:keycode->keysym *display* code 0))
            (multiple-value-bind (cmd key-seq) (get-cmd code state)
              (cond
                ((eq cmd t))
                (cmd
                 (unmap-message-window (current-screen))
                 (interactive-command cmd) t)
-               (t (message "~{~a ~}not bound." (mapcar 'print-key (nreverse key-seq))))))))))
+               (t (message "~{~a ~}not bound." (mapcar 'print-key (nreverse key-seq)))))))
+      ;; When we're done, unfreeze the keyboard
+      (xlib:allow-events *display* :async-keyboard))))
 
 (defun bytes-to-window (bytes)
   "A sick hack to assemble 4 bytes into a 32 bit number. This is

input.lisp

@@ -124,17 +124,17 @@
     ;; Draw the prompt
     (draw-input-bucket screen prompt input)
     ;; Ready to recieve input
-    (xlib:grab-keyboard (screen-input-window screen) :owner-p nil
-                        :sync-keyboard-p nil :sync-pointer-p nil)))
+    
+))
 
 (defun shutdown-input-window (screen)
   (xlib:ungrab-keyboard *display*)
   (xlib:unmap-window (screen-input-window screen)))
 
-(defun input-handle-key-press-event (&rest event-slots &key root code state &allow-other-keys)
+(defun input-handle-key-press-event (&rest event-slots &key event-key root code state &allow-other-keys)
   (declare (ignore event-slots root))
   ;; FIXME: don't use a cons
-  (cons code state))
+  (list* event-key code state))
 
 (defun input-handle-selection-event (&key window selection property &allow-other-keys)
   (declare (ignore selection))
@@ -145,18 +145,14 @@
 (defun read-key-handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   (case event-key
-    (:key-release
-     't)
-    (:key-press
+    ((or :key-release :key-press)
      (apply 'input-handle-key-press-event event-slots))
     (t nil)))
 
 (defun read-key-or-selection-handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   (case event-key
-    (:key-release
-     't)
-    (:key-press
+    ((or :key-release :key-press)
      (apply 'input-handle-key-press-event event-slots))
     (:selection-notify
      (apply 'input-handle-selection-event event-slots))
@@ -164,19 +160,31 @@
 
 (defun read-key ()
   "Return a dotted pair (code . state) key."
-  (do ((ret nil (xlib:process-event *display* :handler #'read-key-handle-event :timeout nil)))
-      ((consp ret) ret)))
+  ;; The keyboard is frozen. Thaw it so we can read a key
+  (xlib:allow-events *display* :sync-keyboard)
+  (loop for ev = (xlib:process-event *display* :handler #'read-key-handle-event :timeout nil) do
+       (when (consp ev)
+         (if (eq (first ev) :key-press)
+             (return (cdr ev))
+             (progn
+               (xlib:allow-events *display* :sync-keyboard))))))
 
 (defun read-key-no-modifiers ()
   "Like read-key but never returns a modifier key."
-  (do ((k (read-key) (read-key)))
-      ((not (is-modifier (xlib:keycode->keysym *display* (car k) 0))) k)))
+  (loop for k = (read-key)
+       while (is-modifier (xlib:keycode->keysym *display* (car k) 0))
+       finally (return k)))
 
 (defun read-key-or-selection ()
-  (do ((ret nil (xlib:process-event *display* :handler #'read-key-or-selection-handle-event :timeout nil)))
-      ((or (stringp ret)
-           (consp ret))
-       ret)))
+  ;; The keyboard is frozen. Thaw it so we can read a key
+  (xlib:allow-events *display* :sync-keyboard)
+  (loop for ev = (xlib:process-event *display* :handler #'read-key-or-selection-handle-event :timeout nil) do
+       (cond ((stringp ev)
+              (return ev))
+             ((consp ev)
+              (if (eq (first ev) :key-press)
+                  (return (cdr ev))
+                  (xlib:allow-events *display* :sync-keyboard))))))
 
 (defun make-input-string (initial-input)
   (make-array (length initial-input) :element-type 'character :initial-contents initial-input
@@ -213,17 +221,16 @@ to return a list of matches."
       (setup-input-window screen prompt input)
       (catch :abort
         (unwind-protect
-             (key-loop)
+             (with-focus (screen-input-window screen)
+               (key-loop))
           (shutdown-input-window screen))))))
 
 (defun read-one-char (screen)
   "Read a single character from the user."
-  (grab-keyboard screen)
-  ;; FIXME: should this be in an unwind-protect to ungrab the kbd?
-  (prog1
-      (let ((k (read-key-no-modifiers)))
-        (keycode->character (car k) (xlib:make-state-keys (cdr k))))
-    (ungrab-keyboard)))
+  (with-focus (screen-focus-window screen)
+    (let ((k (read-key-no-modifiers)))
+      (keycode->character (car k) (xlib:make-state-keys (cdr k))))))
+
 
 (defun draw-input-bucket (screen prompt input &optional errorp)
   "Draw to the screen's input window the contents of input."

primitives.lisp

@@ -1051,3 +1051,13 @@ input focus is transfered to the window you click on.")
 
 (defvar *resize-map* nil
   "The keymap used for resizing a window")
+
+(defmacro with-focus (xwin &body body)
+  "Set the focus to xwin, do body, then restore focus"
+  (let ((focus (gensym "FOCUS"))
+        (revert (gensym "REVERT")))
+    `(multiple-value-bind (,focus ,revert) (xlib:input-focus *display*)
+       (xlib:set-input-focus *display* ,xwin :pointer-root)
+       (unwind-protect
+            (progn ,@body)
+         (xlib:set-input-focus *display* ,focus ,revert)))))

user.lisp

@@ -879,13 +879,10 @@ string between them."
     (let ((rest (argument-pop-rest input)))
       (or (and rest (parse-key-seq rest))
           ;; read a key sequence from the user
-          (unwind-protect
-               (progn
-                 (grab-keyboard (current-screen))
-                 (message "~a" prompt)
-                 (nreverse (second (multiple-value-list
-                                    (read-from-keymap *top-map* #'update)))))
-            (ungrab-keyboard))))))
+          (with-focus (screen-focus-window (current-screen))
+            (message "~a" prompt)
+            (nreverse (second (multiple-value-list
+                               (read-from-keymap *top-map* #'update)))))))))
 
 (define-stumpwm-type :window-number (input prompt)
   (let ((n (or (argument-pop input)
@@ -1648,15 +1645,14 @@ See *menu-map* for menu bindings."
          (*suppress-echo-timeout* t))
     (bound-check-menu menu)
     (catch :menu-quit
-      (grab-keyboard screen)
       (unwind-protect
-           (loop
-            (echo-string-list screen menu-text
-                              (+ (menu-state-selected menu) (if prompt 1 0)))
-            (let ((action (read-from-keymap *menu-map*)))
-              (when action
-                (funcall action menu))))
-        (ungrab-keyboard)
+           (with-focus (screen-focus-window screen)
+             (loop
+                (echo-string-list screen menu-text
+                                  (+ (menu-state-selected menu) (if prompt 1 0)))
+                (let ((action (read-from-keymap *menu-map*)))
+                  (when action
+                    (funcall action menu)))))
         (unmap-all-message-windows)))))
 
 (define-stumpwm-command "windowlist" ((fmt :rest))