[clfswm-cvs] r73 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri Apr 11 21:49:50 UTC 2008
Author: pbrochard
Date: Fri Apr 11 17:49:46 2008
New Revision: 73
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-keys.lisp
clfswm/src/clfswm-query.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/xlib-util.lisp
Log:
Keyboard handle strategie change: Grab all keys by default and replay just what is needed. No change for the second mode.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Apr 11 17:49:46 2008
@@ -1,3 +1,12 @@
+2008-04-11 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm.lisp (main): Keyboard handle strategie change: Grab
+ all keys by default and replay just what is needed. No change for
+ the second mode.
+
+ * src/clfswm-keys.lisp: remove grab/ungrab main keys.
+ (find-key-from-code): Test for shift and not shift presence.
+
2008-04-09 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-internal.lisp (switch-to-root-frame): show later -
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Fri Apr 11 17:49:46 2008
@@ -11,8 +11,6 @@
and redisplay only the wanted child). *** REALLY URGENT ***
Split computation of geometry outside of show-all-children. [Philippe]
-- Rethink the keysym part with shift+1/!.
-
- Hook to open next window in named/numbered frame [Philippe]
- Undo/redo (any idea to implement this is welcome)
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Fri Apr 11 17:49:46 2008
@@ -253,8 +253,8 @@
(defun utility-menu ()
"Utility menu"
(info-mode-menu '((#\i identify-key)
- (#\: eval-from-query-string)
- (#\! run-program-from-query-string))))
+ ("colon" eval-from-query-string)
+ ("exclam" run-program-from-query-string))))
(defun main-menu ()
"Open the main menu"
@@ -280,10 +280,10 @@
;;(define-second-key (#\g :control) 'stop-all-pending-actions)
-(define-second-key (#\i) 'identify-key)
-(define-second-key (#\:) 'eval-from-query-string)
+(define-second-key ("i") 'identify-key)
+(define-second-key ("colon") 'eval-from-query-string)
-(define-second-key (#\!) 'run-program-from-query-string)
+(define-second-key ("exclam") 'run-program-from-query-string)
(define-second-key (#\t) 'leave-second-mode)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Apr 11 17:49:46 2008
@@ -737,6 +737,7 @@
(:transient 1)
(t 1)))
(grab-all-buttons window)
+ (grab-all-keys window)
(unless (do-all-frames-nw-hook window)
(default-frame-nw-hook nil window))
(netwm-add-in-client-list window)))
Modified: clfswm/src/clfswm-keys.lisp
==============================================================================
--- clfswm/src/clfswm-keys.lisp (original)
+++ clfswm/src/clfswm-keys.lisp Fri Apr 11 17:49:46 2008
@@ -99,29 +99,31 @@
-(defmacro define-ungrab/grab (name function hashtable)
- `(defun ,name ()
- (maphash #'(lambda (k v)
- (declare (ignore v))
- (when (consp k)
- (handler-case
- (let* ((key (first k))
- (keycode (typecase key
- (character (char->keycode key))
- (number key)
- (string (let ((keysym (keysym-name->keysym key)))
- (and keysym (xlib:keysym->keycodes *display* keysym)))))))
- (if keycode
- (,function *root* keycode :modifiers (second k))
- (format t "~&Grabbing error: Can't find key '~A'~%" key)))
- (error (c)
- ;;(declare (ignore c))
- (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
- (force-output)))
- ,hashtable)))
-
-(define-ungrab/grab grab-main-keys xlib:grab-key *main-keys*)
-(define-ungrab/grab ungrab-main-keys xlib:ungrab-key *main-keys*)
+;;(defmacro define-ungrab/grab (name function hashtable)
+;; `(defun ,name ()
+;; (maphash #'(lambda (k v)
+;; (declare (ignore v))
+;; (when (consp k)
+;; (handler-case
+;; (let* ((key (first k))
+;; (modifiers (second k))
+;; (keycode (typecase key
+;; (character (char->keycode key))
+;; (number key)
+;; (string (let ((keysym (keysym-name->keysym key)))
+;; (when keysym
+;; (xlib:keysym->keycodes *display* keysym)))))))
+;; (if keycode
+;; (,function *root* keycode :modifiers modifiers)
+;; (format t "~&Grabbing error: Can't find key '~A'~%" key)))
+;; (error (c)
+;; ;;(declare (ignore c))
+;; (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
+;; (force-output)))
+;; ,hashtable)))
+;;
+;;(define-ungrab/grab grab-main-keys xlib:grab-key *main-keys*)
+;;(define-ungrab/grab ungrab-main-keys xlib:ungrab-key *main-keys*)
@@ -134,9 +136,9 @@
(defun find-key-from-code (hash-table-key code state)
"Return the function associated to code/state"
- (labels ((function-from (key)
+ (labels ((function-from (key &optional (new-state state))
(multiple-value-bind (function foundp)
- (gethash (list key state) hash-table-key)
+ (gethash (list key new-state) hash-table-key)
(when (and foundp (first function))
function)))
(from-code ()
@@ -145,12 +147,18 @@
(let ((char (keycode->char code state)))
(function-from char)))
(from-string ()
- (let* ((modifiers (xlib:make-state-keys state))
+ (let* ((modifiers (state->modifiers state))
+ (string (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
+ ((member :mod-5 modifiers) 2)
+ (t 0))))))
+ (function-from string)))
+ (from-string-no-shift ()
+ (let* ((modifiers (state->modifiers state))
(string (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
((member :mod-5 modifiers) 2)
(t 0))))))
- (function-from string))))
- (or (from-code) (from-char) (from-string))))
+ (function-from string (modifiers->state (remove :shift modifiers))))))
+ (or (from-code) (from-char) (from-string) (from-string-no-shift))))
Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp (original)
+++ clfswm/src/clfswm-query.lisp Fri Apr 11 17:49:46 2008
@@ -112,7 +112,7 @@
(setf result-string (subseq result-string 0 pos)))
(handle-query-key (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
- (let* ((modifiers (xlib:make-state-keys state))
+ (let* ((modifiers (state->modifiers state))
(keysym (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
((member :mod-5 modifiers) 2)
(t 0))))
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Fri Apr 11 17:49:46 2008
@@ -144,7 +144,7 @@
(defun sm-handle-event (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
- ;;(dbg event-key)
+ ;; (dbg event-key)
(with-xlib-protect
(case event-key
(:button-press (call-hook *sm-button-press-hook* event-slots))
@@ -177,7 +177,7 @@
:border-width 1
:border (get-color *sm-border-color*)
:colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure))
+ :event-mask '(:exposure :key-press :key-release :button-press :button-release))
*sm-font* (xlib:open-font *display* *sm-font-string*)
*sm-gc* (xlib:create-gcontext :drawable *sm-window*
:foreground (get-color *sm-foreground-color*)
@@ -187,7 +187,6 @@
(xlib:map-window *sm-window*)
(draw-second-mode-window)
(no-focus)
- (ungrab-main-keys)
(xgrab-keyboard *root*)
(xgrab-pointer *root* 66 67)
(unwind-protect
@@ -202,7 +201,6 @@
(xlib:destroy-window *sm-window*)
(xungrab-keyboard)
(xungrab-pointer)
- (grab-main-keys)
(show-all-children))
(wait-no-key-or-button-press)
(when *second-mode-program*
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Apr 11 17:49:46 2008
@@ -236,7 +236,7 @@
(print-doc "Second mode: " *second-keys* 4 code state)))
(handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
- (let* ((modifiers (xlib:make-state-keys state))
+ (let* ((modifiers (state->modifiers state))
(key (keycode->char code state))
(keysym (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
((member :mod-5 modifiers) 2)
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri Apr 11 17:49:46 2008
@@ -32,7 +32,9 @@
;;; Main mode hooks
(defun handle-key-press (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
- (funcall-key-from-code *main-keys* code state))
+ (if (funcall-key-from-code *main-keys* code state)
+ (stop-keyboard-event) ;; Maybe TODO: report this in funcall-key-from-code to allow key stop/replay on funcall
+ (replay-keyboard-event)))
(defun handle-button-press (&rest event-slots &key code state window root-x root-y &allow-other-keys)
@@ -200,18 +202,14 @@
*default-font* (xlib:open-font *display* *default-font-string*))
(xgrab-init-pointer)
(xgrab-init-keyboard)
- ;;(xgrab-pointer *root* 66 67 '(:enter-window :button-press :button-release) t) ;; PHIL
- ;;(grab-pointer *root* '(:button-press :button-release)
- ;; :owner-p t :sync-keyboard-p nil :sync-pointer-p nil)
- ;;(grab-button *root* 1 nil ;;'(:button-press :button-release)
- ;; :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil)
- ;;(xlib:grab-pointer *root* nil :owner-p nil)
(xlib:map-window *no-focus-window*)
(dbg *display*)
(setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
:substructure-notify
:property-change
:exposure
+ :key-press
+ :key-release
:button-press
:button-release
:pointer-motion))
@@ -228,7 +226,7 @@
(call-hook *init-hook*)
(process-existing-windows *screen*)
(show-all-children)
- (grab-main-keys)
+ ;;(grab-main-keys)
(xlib:display-finish-output *display*))
@@ -270,7 +268,6 @@
(handler-case
(init-display)
(xlib:access-error (c)
- (ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
(xlib:close-display *display*)
(format t "~&~A~&Maybe another window manager is running.~%" c)
@@ -279,28 +276,8 @@
(unwind-protect
(catch 'exit-main-loop
(main-loop))
- (ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
(xlib:close-display *display*)))
-
-;;(defun perform-click (type code state time)
-;; "Send a button-{press, release} event for button-number. The type of the
-;; sent event will be determined according to the type of the ev event
-;; argument: if type key-press then send button-press, if key-release then
-;; button-release is sent. The destination window will be retreived in the
-;; ev event argument."
-;; (flet ((my-query (win) (multiple-value-list (xlib:query-pointer win))))
-;; (loop with window = *root*
-;; for (x y ssp child nil root-x root-y root) = (my-query window)
-;; while child do (setf window child)
-;; finally
-;; (progn
-;; (dbg window)
-;; (xlib:send-event window type nil
-;; :x x :y y :root-x root-x :root-y root-y
-;; :state state :code code
-;; :window window :event-window window :root root :child child
-;; :same-screen-p ssp :time time)))))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Fri Apr 11 17:49:46 2008
@@ -37,7 +37,11 @@
:colormap-change
:focus-change
:enter-window
- :exposure)
+ :exposure
+ :key-press
+ :key-release
+ :button-press
+ :button-release)
"The events to listen for on managed windows.")
@@ -380,6 +384,7 @@
(defun xgrab-keyboard (root)
(setf keyboard-grabbed t)
(xlib:grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
+
(defun xungrab-keyboard ()
(setf keyboard-grabbed nil)
@@ -401,6 +406,28 @@
:sync-pointer-p t
:sync-keyboard-p nil))
+
+(defun ungrab-all-keys (window)
+ (xlib:ungrab-key window :any :modifiers :any))
+
+(defun grab-all-keys (window)
+ (ungrab-all-keys window)
+ (xlib:grab-key window :any
+ :modifiers :any
+ :owner-p nil
+ :sync-pointer-p nil
+ :sync-keyboard-p t))
+
+
+
+
+(defun stop-keyboard-event ()
+ (xlib:allow-events *display* :sync-keyboard))
+
+(defun replay-keyboard-event ()
+ (xlib:allow-events *display* :replay-keyboard))
+
+
(defun stop-button-event ()
(xlib:allow-events *display* :sync-pointer))
@@ -409,6 +436,8 @@
+
+
(defun get-color (color)
(xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
More information about the clfswm-cvs
mailing list