[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-59-gc389dc8
Philippe Brochard
pbrochard at common-lisp.net
Wed Jun 6 21:05:32 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, test has been updated
via c389dc88d4f97b76b873d6ceeff625a79cc4a343 (commit)
from 1e5611e4818034b5dc32938ea5a4675e96d2d20f (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 c389dc88d4f97b76b873d6ceeff625a79cc4a343
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Wed Jun 6 23:05:26 2012 +0200
src/xlib-util.lisp (handle-event): Add an additional hook event system to handle events in contrib code.
diff --git a/ChangeLog b/ChangeLog
index af5e2df..f9a2014 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-06-06 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/xlib-util.lisp (handle-event): Add an additional hook event
+ system to handle events in contrib code.
+
2012-06-03 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-placement.lisp: Add an optional border size in all
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index c2d6280..7f78336 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -108,22 +108,34 @@
(:vert (vert-text)))))
+
+(defun refresh-toolbar (toolbar)
+ (add-timer (toolbar-refresh-delay toolbar)
+ (lambda ()
+ (refresh-toolbar toolbar))
+ :refresh-toolbar)
+ (clear-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar))
+ (dolist (module (toolbar-modules toolbar))
+ (let ((fun (toolbar-symbol-fun (first module))))
+ (when (fboundp fun)
+ (funcall fun toolbar module))))
+ (copy-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar)))
+
+
+(create-event-hook :exposure)
+
+(defun define-toolbar-hooks (toolbar)
+ (define-event-hook :exposure (window)
+ (when (and (xlib:window-p window) (xlib:window-equal (toolbar-window toolbar) window))
+ (refresh-toolbar toolbar))))
+
+
+
+
(let ((windows-list nil))
(defun is-toolbar-window-p (win)
(and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal)))
- (defun refresh-toolbar (toolbar)
- (add-timer (toolbar-refresh-delay toolbar)
- (lambda ()
- (refresh-toolbar toolbar))
- :refresh-toolbar)
- (clear-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar))
- (dolist (module (toolbar-modules toolbar))
- (let ((fun (toolbar-symbol-fun (first module))))
- (when (fboundp fun)
- (funcall fun toolbar module))))
- (copy-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar)))
-
(defun close-toolbar (toolbar)
(erase-timer :refresh-toolbar-window)
(setf *never-managed-window-list*
@@ -175,7 +187,8 @@
(map-window (toolbar-window toolbar))
(raise-window (toolbar-window toolbar))
(refresh-toolbar toolbar)
- (xlib:display-finish-output *display*))))))))
+ (xlib:display-finish-output *display*)
+ (define-toolbar-hooks toolbar))))))))
(defun open-all-toolbars ()
"Open all toolbars"
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 51a44ed..241cec1 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -292,6 +292,7 @@
(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/tools.lisp b/src/tools.lisp
index 63678d0..40af0b9 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -228,7 +228,9 @@ Return the result of the last hook"
(typecase hook
(cons (dolist (h hook)
(rec h)))
- (t (setf result (apply hook args)))))))
+ (function (setf result (apply hook args)))
+ (symbol (when (fboundp hook)
+ (setf result (apply hook args))))))))
(rec hook)
result)))
@@ -236,14 +238,14 @@ Return the result of the last hook"
(defmacro add-new-hook (hook &rest value)
"Add a hook. Duplicate it if needed"
`(setf ,hook (append (typecase ,hook
- (list ,hook)
- (t (list ,hook)))
- (list , at value))))
+ (list ,hook)
+ (t (list ,hook)))
+ (list , at value))))
(defmacro add-hook (hook &rest value)
"Add a hook only if not duplicated"
(let ((i (gensym)))
- `(dolist (,i (list , at value) ,hook)
+ `(dolist (,i (list , at value))
(unless (member ,i (typecase ,hook
(list ,hook)
(t (list ,hook))))
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 7e42730..6c4fcff 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -170,36 +170,63 @@ Expand in handle-event-fun-main-mode-key-press"
, at body))
+(defun event-hook-name (event-keyword)
+ (create-symbol '*event- event-keyword '-hook*))
-;;; Workaround for pixmap error taken from STUMPWM - thanks:
-;; XXX: In both the clisp and sbcl clx libraries, sometimes what
-;; should be a window will be a pixmap instead. In this case, we
-;; need to manually translate it to a window to avoid breakage
-;; in stumpwm. So far the only slot that seems to be affected is
-;; the :window slot for configure-request and reparent-notify
-;; events. It appears as though the hash table of XIDs and clx
-;; structures gets out of sync with X or perhaps X assigns a
-;; duplicate ID for a pixmap and a window.
-(defun make-xlib-window (xobject)
- "For some reason the clx xid cache screws up returns pixmaps when
-they should be windows. So use this function to make a window out of them."
- #+clisp (make-instance 'xlib:window :id (slot-value xobject 'xlib::id) :display *display*)
- #+(or sbcl ecl openmcl) (xlib::make-window :id (slot-value xobject 'xlib::id) :display *display*)
- #-(or sbcl clisp ecl openmcl)
- (error 'not-implemented))
+(let ((event-hook-list nil))
+ (defmacro create-event-hook (event-keyword)
+ (let ((symb (event-hook-name event-keyword)))
+ (pushnew symb event-hook-list)
+ `(defvar ,symb nil)))
+
+ (defmacro add-event-hook (name &rest value)
+ (let ((symb (event-hook-name name)))
+ `(add-hook ,symb , at value)))
+
+ (defun clear-event-hooks ()
+ (dolist (symb event-hook-list)
+ (makunbound symb))))
+
+
+(defmacro define-event-hook (event-keyword args &body body)
+ `(add-event-hook ,event-keyword
+ (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)))
(defun handle-event (&rest event-slots &key event-key &allow-other-keys)
- (with-xlib-protect ()
- (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))))
- (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)
+ (labels ((make-xlib-window (xobject)
+ "For some reason the clx xid cache screws up returns pixmaps when
+they should be windows. So use this function to make a window out of them."
+ ;; Workaround for pixmap error taken from STUMPWM - thanks:
+ ;; XXX: In both the clisp and sbcl clx libraries, sometimes what
+ ;; should be a window will be a pixmap instead. In this case, we
+ ;; need to manually translate it to a window to avoid breakage
+ ;; in stumpwm. So far the only slot that seems to be affected is
+ ;; the :window slot for configure-request and reparent-notify
+ ;; events. It appears as though the hash table of XIDs and clx
+ ;; structures gets out of sync with X or perhaps X assigns a
+ ;; duplicate ID for a pixmap and a window.
+ #+clisp (make-instance 'xlib:window :id (slot-value xobject 'xlib::id) :display *display*)
+ #+(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 ()
+ (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)
+ (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)))
+ (xlib:display-finish-output *display*))
+ t))
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 +++
contrib/toolbar.lisp | 39 ++++++++++++++++--------
src/clfswm.lisp | 1 +
src/tools.lisp | 12 ++++---
src/xlib-util.lisp | 79 +++++++++++++++++++++++++++++++++----------------
5 files changed, 92 insertions(+), 44 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list