[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-100-g3361fc5
Philippe Brochard
pbrochard at common-lisp.net
Tue Aug 28 11:48:55 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".
The branch, master has been updated
via 3361fc5e9d0f69151d7e444ca4a54df13ccda2d6 (commit)
via 12d85320bdcc73ad19dfb51ffcd4402a9f223003 (commit)
from accd190438b0f42187b1524e21403d5887a0b296 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 3361fc5e9d0f69151d7e444ca4a54df13ccda2d6
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue Aug 28 13:48:49 2012 +0200
src/clfswm-expose-mode.lisp (expose-query-key-press-hook): Add an option to immediately select child if they can be directly accessed.
diff --git a/ChangeLog b/ChangeLog
index 38a5ace..bdcf7fb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-08-28 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-expose-mode.lisp (expose-query-key-press-hook): Add
+ an option to immediately select child if they can be directly
+ accessed.
+
2012-08-25 Philippe Brochard <pbrochard at common-lisp.net>
* contrib/volume-mode.lisp: Add mouse buttons actions in volume
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index 1ec4179..c6422bd 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -103,7 +103,9 @@
(defun expose-query-key-press-hook (code state)
(declare (ignore code state))
- (expose-draw-letter))
+ (expose-draw-letter)
+ (when (and *expose-direct-select* (<= (length *expose-windows-list*) 26))
+ (leave-query-mode :return)))
(defun expose-query-button-press-hook (code state x y)
(declare (ignore state))
diff --git a/src/config.lisp b/src/config.lisp
index 7fdd999..261571a 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -334,7 +334,8 @@ on the root window in the main mode with the mouse")
'Expose-mode "Show the window title on accel window")
(defconfig *expose-transparency* 0.9
'Expose-mode "Expose string window background transparency")
-
+(defconfig *expose-direct-select* t
+ 'Expose-mode "Immediately select child if they can be directly accessed")
;;; CONFIG - Show key binding colors
commit 12d85320bdcc73ad19dfb51ffcd4402a9f223003
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue Aug 28 13:38:41 2012 +0200
src/*.lisp: Use with-xlib-protect macro to prevent a not implemented event x-error
diff --git a/contrib/volume-mode.lisp b/contrib/volume-mode.lisp
index c21770c..cffc420 100644
--- a/contrib/volume-mode.lisp
+++ b/contrib/volume-mode.lisp
@@ -199,7 +199,7 @@
:border (when (plusp *volume-border-size*)
(get-color *volume-border*))
:colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press))
+ :event-mask '(:exposure :key-press :button-press))
*volume-gc* (xlib:create-gcontext :drawable *volume-window*
:foreground (get-color *volume-foreground*)
:background (get-color *volume-background*)
@@ -243,17 +243,18 @@
(unless grab-keyboard-p
(ungrab-main-keys)
(xgrab-keyboard *root*))
- (generic-mode 'volume-mode 'exit-volume-loop
- :enter-function 'volume-enter-function
- :loop-function 'volume-loop-function
- :leave-function 'volume-leave-function
- :original-mode '(main-mode))
- (unless grab-keyboard-p
- (xungrab-keyboard)
- (grab-main-keys))
- (if grab-pointer-p
- (xgrab-pointer *root* 66 67)
- (xungrab-pointer))))
+ (unwind-protect
+ (generic-mode 'volume-mode 'exit-volume-loop
+ :enter-function 'volume-enter-function
+ :loop-function 'volume-loop-function
+ :leave-function 'volume-leave-function
+ :original-mode '(main-mode))
+ (unless grab-keyboard-p
+ (xungrab-keyboard)
+ (grab-main-keys))
+ (if grab-pointer-p
+ (xgrab-pointer *root* 66 67)
+ (xungrab-pointer)))))
(defun volume-set (fn)
(when fn
diff --git a/src/clfswm-generic-mode.lisp b/src/clfswm-generic-mode.lisp
index c7eab3f..c8f3978 100644
--- a/src/clfswm-generic-mode.lisp
+++ b/src/clfswm-generic-mode.lisp
@@ -25,27 +25,29 @@
(in-package :clfswm)
-
(defun generic-mode (mode exit-tag &key enter-function loop-function leave-function
- (loop-hook *loop-hook*) original-mode)
+ (loop-hook *loop-hook*) original-mode)
"Enter in a generic mode"
(let ((last-mode *current-event-mode*))
(unassoc-keyword-handle-event)
(when original-mode
(dolist (add-mode (ensure-list original-mode))
- (assoc-keyword-handle-event add-mode)))
+ (assoc-keyword-handle-event add-mode)))
(assoc-keyword-handle-event mode)
(nfuncall enter-function)
(catch exit-tag
(unwind-protect
- (loop
- (call-hook loop-hook)
- (process-timers)
- (nfuncall loop-function)
- (when (xlib:event-listen *display* *loop-timeout*)
- (xlib:process-event *display* :handler #'handle-event))
- (xlib:display-finish-output *display*))
- (nfuncall leave-function)
- (unassoc-keyword-handle-event)
- (assoc-keyword-handle-event last-mode)))))
+ (loop
+ (with-xlib-protect (:generic-mode exit-tag)
+ (call-hook loop-hook)
+ (process-timers)
+ (nfuncall loop-function)
+ (when (xlib:event-listen *display* *loop-timeout*)
+ (xlib:process-event *display* :handler #'handle-event))
+ (xlib:display-finish-output *display*)))
+ (progn
+ (nfuncall leave-function)
+ (unassoc-keyword-handle-event)
+ (assoc-keyword-handle-event last-mode))))))
+
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index d00877b..794b506 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -549,12 +549,14 @@
(force-output)
(unwind-protect
(loop until done do
- (when (xlib:event-listen *display* *loop-timeout*)
- (xlib:process-event *display* :handler #'handle-identify))
- (xlib:display-finish-output *display*))
- (xlib:destroy-window window)
- (xlib:close-font font)
- (xgrab-pointer *root* 66 67)))))
+ (with-xlib-protect (:Identify-Loop nil)
+ (when (xlib:event-listen *display* *loop-timeout*)
+ (xlib:process-event *display* :handler #'handle-identify))
+ (xlib:display-finish-output *display*)))
+ (progn
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (xgrab-pointer *root* 66 67))))))
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index f8429ce..0529b02 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -157,9 +157,10 @@
(defun main-loop ()
(loop
- (call-hook *loop-hook*)
- (process-timers)
- (with-xlib-protect ()
+ (with-xlib-protect (:main-loop nil)
+ (call-hook *loop-hook*)
+ (process-timers)
+ ;;(with-xlib-protect ()
(when (xlib:event-listen *display* *loop-timeout*)
(xlib:process-event *display* :handler #'handle-event))
(xlib:display-finish-output *display*))))
@@ -289,15 +290,16 @@
(catch 'exit-main-loop
(unwind-protect
(main-loop)
- (ungrab-main-keys)
- (xlib:destroy-window *no-focus-window*)
- (xlib:free-pixmap *pixmap-buffer*)
- (destroy-all-frames-window)
- (call-hook *close-hook*)
- (clear-event-hooks)
- (xlib:close-display *display*)
- #+:event-debug
- (format t "~2&Unhandled events: ~A~%" *unhandled-events*))))
+ (progn
+ (ungrab-main-keys)
+ (xlib:destroy-window *no-focus-window*)
+ (xlib:free-pixmap *pixmap-buffer*)
+ (destroy-all-frames-window)
+ (call-hook *close-hook*)
+ (clear-event-hooks)
+ (xlib:close-display *display*)
+ #+:event-debug
+ (format t "~2&Unhandled events: ~A~%" *unhandled-events*)))))
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index b5e1699..2e0573f 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -65,17 +65,37 @@ Window types are in +WINDOW-TYPES+.")
"Alist mapping NETWM window types to keywords.")
-(defmacro with-xlib-protect (() &body body)
+;;(defmacro with-xlib-protect (() &body body)
+;; "Prevent Xlib errors"
+;; `(handler-case
+;; (with-simple-restart (top-level "Return to clfswm's top level")
+;; , at body)
+;; ((or xlib:match-error xlib:window-error xlib:drawable-error xlib:lookup-error) (c)
+;; (progn
+;; (format t "Ignoring XLib error: ~S~%" c)
+;; (unassoc-keyword-handle-event)
+;; (assoc-keyword-handle-event 'main-mode)
+;; (setf *in-second-mode* nil)))))
+
+
+(defmacro with-xlib-protect ((&optional name tag) &body body)
"Prevent Xlib errors"
`(handler-case
(with-simple-restart (top-level "Return to clfswm's top level")
, at body)
- ((or xlib:match-error xlib:window-error xlib:drawable-error xlib:lookup-error) (c)
- (progn
- (format t "Ignoring XLib error: ~S~%" c)
- (unassoc-keyword-handle-event)
- (assoc-keyword-handle-event 'main-mode)
- (setf *in-second-mode* nil)))))
+ (xlib::x-error (c)
+ (declare (ignore c))
+ (if ,tag
+ (format t "~A ~A~%" ,name ,tag)
+ (format t "~A ~A~%" ,name ',body))
+ (force-output))))
+
+;; (format t "Ignoring XLib error: ~S~%" c))))
+;; (funcall 'exit-generic-mode))))
+;; (unassoc-keyword-handle-event)
+;; (assoc-keyword-handle-event 'main-mode)
+;; (setf *in-second-mode* nil))))
+
(defmacro with-x-pointer (&body body)
@@ -169,7 +189,8 @@ Expand in handle-event-fun-main-mode-key-press"
`(defun ,(keyword->handle-event mode keyword) (&rest event-slots &key #+:event-debug event-key , at args &allow-other-keys)
(declare (ignorable event-slots))
#+:event-debug (print (list *current-event-mode* event-key))
- , at body))
+ (with-xlib-protect (:define-handler (list ',mode ,keyword))
+ , at body)))
(defun event-hook-name (event-keyword)
@@ -217,9 +238,11 @@ Expand in handle-event-fun-main-mode-key-press"
`(let ((,event-fun (lambda (&rest event-slots &key #+:event-debug event-key , at args &allow-other-keys)
(declare (ignorable event-slots))
#+:event-debug (print (list ,event-keyword event-key))
- , at body)))
+ (with-xlib-protect (:define-event-hook ,event-keyword)
+ , at body))))
(add-event-hook ,event-keyword ,event-fun)
- ,event-fun)))
+ (with-xlib-protect (:define-event-hook-2 ,event-keyword)
+ ,event-fun))))
(defmacro event-defun (name args &body body)
@@ -249,18 +272,20 @@ they should be windows. So use this function to make a window out of them."
#+(or sbcl ecl openmcl) (xlib::make-window :id (slot-value xobject 'xlib::id) :display *display*)
#-(or sbcl clisp ecl openmcl)
(error 'not-implemented)))
- (with-xlib-protect ()
+ (with-xlib-protect (:handle-event event-key)
(catch 'exit-handle-event
(let ((win (getf event-slots :window)))
(when (and win (not (xlib:window-p win)))
(dbg "Pixmap Workaround! Should be a window: " win)
(setf (getf event-slots :window) (make-xlib-window win))))
- (let ((hook-symbol (event-hook-name event-key)))
- (when (boundp hook-symbol)
- (apply #'call-hook (symbol-value hook-symbol) event-slots)))
- (if (fboundp event-key)
- (apply event-key event-slots)
- #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal)))
+ (with-xlib-protect (:handle-event-2 event-key)
+ (let ((hook-symbol (event-hook-name event-key)))
+ (when (boundp hook-symbol)
+ (apply #'call-hook (symbol-value hook-symbol) event-slots))))
+ (with-xlib-protect (:handle-event-3 event-key)
+ (if (fboundp event-key)
+ (apply event-key event-slots)
+ #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal))))
(xlib:display-finish-output *display*))
t))
@@ -838,11 +863,12 @@ they should be windows. So use this function to make a window out of them."
(unwind-protect
(progn
, at body)
- (if pointer-grabbed
- (xgrab-pointer *root* ,old-cursor ,old-mask)
- (xungrab-pointer))
- (unless keyboard-grabbed
- (xungrab-keyboard)))))
+ (progn
+ (if pointer-grabbed
+ (xgrab-pointer *root* ,old-cursor ,old-mask)
+ (xungrab-pointer))
+ (unless keyboard-grabbed
+ (xungrab-keyboard))))))
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 6 +++
contrib/volume-mode.lisp | 25 ++++++++-------
src/clfswm-expose-mode.lisp | 4 ++-
src/clfswm-generic-mode.lisp | 28 +++++++++--------
src/clfswm-util.lisp | 14 +++++---
src/clfswm.lisp | 26 ++++++++-------
src/config.lisp | 3 +-
src/xlib-util.lisp | 70 ++++++++++++++++++++++++++++-------------
8 files changed, 109 insertions(+), 67 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list