[STUMP] [STUMPWM][PATCH] Timing out Grabed Pointer

[Sharad Pratap]

>From cf1f8fa087bcd050dd8d0fa578fed27e9f2e9aa7 Mon Sep 17 00:00:00 2001
Cancel-Lock: sha1:1CuTN+LAjrbYdB5H5W7IuNJ5fZI=


Releasing and stop reading (read-char) for the grabbed pointer after
*grab-pointer-timeout* seconds so in case if user forget providing any
keyboard input after pressing prefix key, stumpwm will wait for
specified seconds than stop reading next char and again ungrab point
back.

Signed-off-by: Sharad Pratap <address@hidden>
---
 events.lisp     | 13 +++++++++----
 input.lisp      | 38 +++++++++++++++++++++++++++++---------
 primitives.lisp |  6 ++++++
 3 files changed, 44 insertions(+), 13 deletions(-)

diff --git a/events.lisp b/events.lisp
index 3f659c4..c9479e9 100644
--- a/events.lisp
+++ b/events.lisp
@@ -227,12 +227,17 @@ The Caller is responsible for setting up the input focus."
     (cond ((kmap-or-kmap-symbol-p match)
            (when grab
              (grab-pointer (current-screen)))
-           (let* ((code-state (read-key-no-modifiers))
+           (let* ((code-state (read-key-no-modifiers *grab-pointer-timeout*))
                   (code (car code-state))
                   (state (cdr code-state)))
-             (unwind-protect
-                  (handle-keymap (remove-if-not 'kmap-or-kmap-symbol-p 
bindings) code state key-seq nil update-fn)
-               (when grab (ungrab-pointer)))))
+             (if code-state
+                 (unwind-protect
+                      (handle-keymap (remove-if-not 'kmap-or-kmap-symbol-p 
bindings) code state key-seq nil update-fn)
+                   (when grab (ungrab-pointer)))
+                 (progn
+                   (when grab (ungrab-pointer))
+                   (keyboard-quit)
+                   (values t nil)))))
           (match
            (values match key-seq))
           ((and (find key (list (kbd "?")
diff --git a/input.lisp b/input.lisp
index 3013b87..df2d657 100644
--- a/input.lisp
+++ b/input.lisp
@@ -154,18 +154,38 @@
      (apply 'input-handle-selection-event event-slots))
     (t nil)))

-(defun read-key ()
+(defun read-key (&optional timeout)
   "Return a dotted pair (code . state) key."
-  (loop for ev = (xlib:process-event *display* :handler 
#'read-key-handle-event :timeout nil) do
-       (when (and (consp ev)
-                  (eq (first ev) :key-press))
-           (return (cdr ev)))))
+  (declare (type (or null fixnum) timeout))
+  (let ((start (if timeout (get-universal-time))))
+    (loop for ev = (xlib:process-event *display* :handler 
#'read-key-handle-event :timeout timeout) do

-(defun read-key-no-modifiers ()
+         (if (and (consp ev)
+                  (eq (first ev) :key-press))
+             (return (cdr ev))
+             (when (and timeout
+                        (numberp timeout))
+               (if (<= timeout 0)
+                   (return nil)
+                   (setq timeout
+                         (- timeout
+                            (- (get-universal-time) start)))))))))
+
+(defun read-key-no-modifiers (&optional timeout)
   "Like read-key but never returns a modifier key."
-  (loop for k = (read-key)
-       while (is-modifier (car k))
-       finally (return k)))
+  (declare (type (or null fixnum) timeout))
+  (dformat 1 "read-key-no-modifiers: ~a~%" timeout)
+  (let ((start (if timeout (get-universal-time))))
+    (loop for k = (read-key timeout)
+       while (and k (is-modifier (car k)))
+       finally (return k) do
+         (when (and timeout
+                    (numberp timeout))
+           (if (<= timeout 0)
+               (return nil)
+               (setq timeout
+                     (- timeout
+                        (- (get-universal-time) start))))))))

 (defun read-key-or-selection ()
   (loop for ev = (xlib:process-event *display* :handler 
#'read-key-or-selection-handle-event :timeout nil) do
diff --git a/primitives.lisp b/primitives.lisp
index 50d062e..090ca60 100644
--- a/primitives.lisp
+++ b/primitives.lisp
@@ -56,6 +56,7 @@
           *transient-border-width*
           *normal-border-width*
           *text-color*
+          *grab-pointer-timeout*
           *window-events*
           *window-parent-events*
           *message-window-padding*
@@ -259,6 +260,11 @@ the mode-line, the button clicked, and the x and y of the 
pointer.")
 (defvar *menu-scrolling-step* 1
   "Number of lines to scroll when hitting the menu list limit.")

+;; Input defaults
+(defvar *grab-pointer-timeout* 7
+  "Seconds pointer could be left grabbed.")
+
+
 (defparameter +netwm-supported+
   '(:_NET_SUPPORTING_WM_CHECK
     :_NET_NUMBER_OF_DESKTOPS
--
1.8.1.2