[clfswm-cvs] r75 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sun Apr 13 21:43:56 UTC 2008
Author: pbrochard
Date: Sun Apr 13 17:43:53 2008
New Revision: 75
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-keys.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm.lisp
clfswm/src/xlib-util.lisp
Log:
Better handle of keysyms. Revert to hold grabning method for the main mode.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sun Apr 13 17:43:53 2008
@@ -1,3 +1,8 @@
+2008-04-13 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-keys.lisp (find-key-from-code): Better handle of
+ keysyms. Revert to hold grabning method for the main mode.
+
2008-04-12 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm.lisp (init-display): Add key handling on no focus
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Sun Apr 13 17:43:53 2008
@@ -210,8 +210,7 @@
:colormap (xlib:screen-default-colormap *screen*)
:border-width 1
:border (get-color "Red")
- :event-mask '(:exposure :key-press :key-release
- :button-press :button-release :pointer-motion)))
+ :event-mask '(:exposure :button-press :button-release :pointer-motion)))
(gc (xlib:create-gcontext :drawable window
:foreground (get-color "Green")
:background (get-color "Black")
@@ -738,7 +737,6 @@
(: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 Sun Apr 13 17:43:53 2008
@@ -99,31 +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))
-;; (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*)
+(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*)
@@ -147,6 +147,9 @@
(let ((char (keycode->char code state)))
(function-from char)))
(from-string ()
+ (let ((string (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+ (function-from string)))
+ (from-string-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)
@@ -158,7 +161,7 @@
((member :mod-5 modifiers) 2)
(t 0))))))
(function-from string (modifiers->state (remove :shift modifiers))))))
- (or (from-code) (from-char) (from-string) (from-string-no-shift))))
+ (or (from-code) (from-char) (from-string) (from-string-shift) (from-string-no-shift))))
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Sun Apr 13 17:43:53 2008
@@ -177,7 +177,7 @@
:border-width 1
:border (get-color *sm-border-color*)
:colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press :key-release :button-press :button-release))
+ :event-mask '(:exposure))
*sm-font* (xlib:open-font *display* *sm-font-string*)
*sm-gc* (xlib:create-gcontext :drawable *sm-window*
:foreground (get-color *sm-foreground-color*)
@@ -187,6 +187,7 @@
(xlib:map-window *sm-window*)
(draw-second-mode-window)
(no-focus)
+ (ungrab-main-keys)
(xgrab-keyboard *root*)
(xgrab-pointer *root* 66 67)
(unwind-protect
@@ -201,6 +202,7 @@
(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.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Sun Apr 13 17:43:53 2008
@@ -32,9 +32,7 @@
;;; Main mode hooks
(defun handle-key-press (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
- (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)))
+ (funcall-key-from-code *main-keys* code state))
(defun handle-button-press (&rest event-slots &key code state window root-x root-y &allow-other-keys)
@@ -194,9 +192,7 @@
(defun init-display ()
(setf *screen* (first (xlib:display-roots *display*))
*root* (xlib:screen-root *screen*)
- *no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1
- :event-mask '(:key-press :key-release
- :button-press :button-release :pointer-motion))
+ *no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
*root-gc* (xlib:create-gcontext :drawable *root*
:foreground (get-color *color-unselected*)
:background (get-color "Black")
@@ -210,8 +206,6 @@
:substructure-notify
:property-change
:exposure
- :key-press
- :key-release
:button-press
:button-release
:pointer-motion))
@@ -228,7 +222,7 @@
(call-hook *init-hook*)
(process-existing-windows *screen*)
(show-all-children)
- ;;(grab-main-keys)
+ (grab-main-keys)
(xlib:display-finish-output *display*))
@@ -270,6 +264,7 @@
(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)
@@ -278,6 +273,7 @@
(unwind-protect
(catch 'exit-main-loop
(main-loop))
+ (ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
(xlib:close-display *display*)))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sun Apr 13 17:43:53 2008
@@ -37,11 +37,7 @@
:colormap-change
:focus-change
:enter-window
- :exposure
- :key-press
- :key-release
- :button-press
- :button-release)
+ :exposure)
"The events to listen for on managed windows.")
@@ -410,22 +406,31 @@
(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 grab-all-keys (window)
+;; (ungrab-all-keys window)
+;; (dolist (modifiers '(:control :mod-1 :shift))
+;; (xlib:grab-key window :any
+;; :modifiers (list modifiers)
+;; :owner-p nil
+;; :sync-pointer-p nil
+;; :sync-keyboard-p t)))
+
+;;(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-keyboard-event ()
+;; (xlib:allow-events *display* :sync-keyboard))
+;;
+;;(defun replay-keyboard-event ()
+;; (xlib:allow-events *display* :replay-keyboard))
(defun stop-button-event ()
More information about the clfswm-cvs
mailing list