[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-60-g7057baa

Philippe Brochard pbrochard at common-lisp.net
Thu Jun 7 20:50:58 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  7057baaaf3e5dc4372b8385534b540a12edbadcd (commit)
      from  c389dc88d4f97b76b873d6ceeff625a79cc4a343 (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 7057baaaf3e5dc4372b8385534b540a12edbadcd
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu Jun 7 22:50:51 2012 +0200

    contrib/toolbar.lisp (define-toolbar-hooks): Add auto-hide clickable toolbar.

diff --git a/ChangeLog b/ChangeLog
index f9a2014..acaf844 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-06-07  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/toolbar.lisp (define-toolbar-hooks): Add auto-hide
+	clickable toolbar.
+
 2012-06-06  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/xlib-util.lisp (handle-event): Add an additional hook event
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 7f78336..9df8750 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -57,6 +57,8 @@
   'Toolbar "Toolbar default refresh delay")
 (defconfig *toolbar-default-autohide* nil
   'Toolbar "Toolbar default autohide value")
+(defconfig *toolbar-sensibility* 3
+  'Toolbar "Toolbar sensibility in pixels")
 
 (defconfig *toolbar-window-placement* 'top-left-placement
   'Placement "Toolbar window placement")
@@ -121,14 +123,59 @@
         (funcall fun toolbar module))))
   (copy-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar)))
 
-
-(create-event-hook :exposure)
-
-(defun define-toolbar-hooks (toolbar)
+(defun toolbar-in-sensibility-zone-p (toolbar root-x root-y)
+  (let* ((tb-win (toolbar-window toolbar))
+         (win-x (xlib:drawable-x tb-win))
+         (win-y (xlib:drawable-y tb-win))
+         (width (xlib:drawable-width tb-win))
+         (height (xlib:drawable-height tb-win))
+         (tb-dir (toolbar-direction toolbar) )
+         (placement-name (symbol-name (toolbar-placement toolbar))))
+    (or (and (equal tb-dir :horiz) (search "TOP" placement-name)
+             (<= root-y win-y (+ root-y *toolbar-sensibility*))
+             (<= win-x root-x (+ win-x width)) (toolbar-autohide toolbar))
+        (and (equal tb-dir :horiz) (search "BOTTOM" placement-name)
+             (<= (+ win-y height) root-y (+ win-y height *toolbar-sensibility*))
+             (<= win-x root-x (+ win-x width)) (toolbar-autohide toolbar))
+        (and (equal tb-dir :vert) (search "LEFT" placement-name)
+             (<= root-x win-x (+ root-x *toolbar-sensibility*))
+             (<= win-y root-y (+ win-y height)) (toolbar-autohide toolbar))
+        (and (equal tb-dir :vert) (search "RIGHT" placement-name)
+             (<= (+ win-x width) root-x (+ win-x win-x *toolbar-sensibility*))
+             (<= win-y root-y (+ win-y height)) (toolbar-autohide toolbar)))))
+
+(use-event-hook :exposure)
+(use-event-hook :button-press)
+
+
+(defun toolbar-add-exposure-hook (toolbar)
   (define-event-hook :exposure (window)
     (when (and (xlib:window-p window) (xlib:window-equal (toolbar-window toolbar) window))
       (refresh-toolbar toolbar))))
 
+(defun toolbar-add-hide-button-press-hook (toolbar)
+  (let ((hide t))
+    (define-event-hook :button-press (code root-x root-y)
+      (when (= code 1)
+        (let* ((tb-win (toolbar-window toolbar)))
+          (when (toolbar-in-sensibility-zone-p toolbar root-x root-y)
+            (if hide
+                (progn
+                  (map-window tb-win)
+                  (raise-window tb-win)
+                  (refresh-toolbar toolbar))
+                (hide-window tb-win))
+            (setf hide (not hide))
+            (wait-mouse-button-release)
+            (stop-button-event)
+            (throw 'exit-handle-event nil)))))))
+
+(defun define-toolbar-hooks (toolbar)
+  (toolbar-add-exposure-hook toolbar)
+  (case (toolbar-autohide toolbar)
+    (:click (toolbar-add-hide-button-press-hook toolbar))))
+
+
 
 
 
@@ -184,9 +231,10 @@
               (push (toolbar-window toolbar) windows-list)
               (setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
               (push (list #'is-toolbar-window-p nil) *never-managed-window-list*)
-              (map-window (toolbar-window toolbar))
-              (raise-window (toolbar-window toolbar))
-              (refresh-toolbar toolbar)
+              (unless (toolbar-autohide toolbar)
+                (map-window (toolbar-window toolbar))
+                (raise-window (toolbar-window toolbar))
+                (refresh-toolbar toolbar))
               (xlib:display-finish-output *display*)
               (define-toolbar-hooks toolbar))))))))
 
@@ -232,6 +280,10 @@
 
 
 
+
+;;;
+;;; Modules definitions
+;;;
 (define-toolbar-module (clock)
   "The clock module"
   (multiple-value-bind (s m h)
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 6c4fcff..b77ad4c 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -174,7 +174,7 @@ Expand in handle-event-fun-main-mode-key-press"
   (create-symbol '*event- event-keyword '-hook*))
 
 (let ((event-hook-list nil))
-  (defmacro create-event-hook (event-keyword)
+  (defmacro use-event-hook (event-keyword)
     (let ((symb (event-hook-name event-keyword)))
       (pushnew symb event-hook-list)
       `(defvar ,symb nil)))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog            |    5 ++++
 contrib/toolbar.lisp |   66 ++++++++++++++++++++++++++++++++++++++++++++-----
 src/xlib-util.lisp   |    2 +-
 3 files changed, 65 insertions(+), 8 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager




More information about the clfswm-cvs mailing list