From 92c06b8c12a4e3cf3adfd9868ad16974a0fe604c Mon Sep 17 00:00:00 2001
From: Philippe Brochard <pbrochard@common-lisp.net>
Date: Tue, 12 Jun 2012 22:13:10 +0200
Subject: [PATCH] contrib/toolbar.lisp: beginning of clickable modules

---
 contrib/toolbar.lisp      | 38 +++++++++++++++++++++++++++++---------
 src/clfswm-placement.lisp | 46 ++++++++++++++++++++++++----------------------
 2 files changed, 53 insertions(+), 31 deletions(-)

diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 1e6552e..17e2ad7 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -33,7 +33,7 @@
 (format t "Loading Toolbar code... ")
 
 (defstruct toolbar root-x root-y root direction size thickness placement refresh-delay
-           autohide modules font window gc border-size)
+           autohide modules clickable font window gc border-size)
 
 (defparameter *toolbar-list* nil)
 (defparameter *toolbar-module-list* nil)
@@ -57,7 +57,7 @@
   'Toolbar "Toolbar default refresh delay")
 (defconfig *toolbar-default-autohide* nil
   'Toolbar "Toolbar default autohide value")
-(defconfig *toolbar-sensibility* 3
+(defconfig *toolbar-sensibility* 10
   'Toolbar "Toolbar sensibility in pixels")
 
 (defconfig *toolbar-window-placement* 'top-left-placement
@@ -135,13 +135,13 @@
              (<= 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-y height (- *toolbar-sensibility*)) root-y (+ win-y height))
              (<= 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-x width (- *toolbar-sensibility*)) root-x (+ win-x width))
              (<= win-y root-y (+ win-y height)) (toolbar-autohide toolbar)))))
 
 (use-event-hook :exposure)
@@ -182,18 +182,28 @@
         (throw 'exit-handle-event nil)))))
 
 (defun toolbar-add-hide-leave-hook (toolbar)
-  (define-event-hook :leave-notify (window)
-    (when (xlib:window-equal (toolbar-window toolbar) window)
+  (define-event-hook :leave-notify (window root-x root-y)
+    (when (and (xlib:window-equal (toolbar-window toolbar) window)
+               (not (in-window (toolbar-window toolbar) root-x root-y)))
       (hide-window window)
       (throw 'exit-handle-event nil))))
 
 (defun define-toolbar-hooks (toolbar)
   (toolbar-add-exposure-hook toolbar)
+  (when (toolbar-clickable toolbar)
+    (define-event-hook :button-press (code root-x root-y)
+      (dbg code root-x root-y)))
   (case (toolbar-autohide toolbar)
     (:click (toolbar-add-hide-button-press-hook toolbar))
     (:motion (toolbar-add-hide-motion-hook toolbar)
              (toolbar-add-hide-leave-hook toolbar))))
 
+(defun set-clickable-toolbar (toolbar)
+  (dolist (module *toolbar-module-list*)
+    (when (and (member (first module) (toolbar-modules toolbar)
+                       :test (lambda (x y) (equal x (first y))))
+               (second module))
+      (setf (toolbar-clickable toolbar) t))))
 
 
 
@@ -252,10 +262,11 @@
               (push (list #'is-toolbar-window-p nil) *never-managed-window-list*)
               (map-window (toolbar-window toolbar))
               (raise-window (toolbar-window toolbar))
-              (refresh-toolbar toolbar);)
+              (refresh-toolbar toolbar)
               (when (toolbar-autohide toolbar)
                 (hide-window (toolbar-window toolbar)))
               (xlib:display-finish-output *display*)
+              (set-clickable-toolbar toolbar)
               (define-toolbar-hooks toolbar))))))))
 
 (defun open-all-toolbars ()
@@ -292,10 +303,10 @@
 (add-hook *close-hook* 'close-all-toolbars)
 
 
-(defmacro define-toolbar-module ((name) &body body)
+(defmacro define-toolbar-module ((name &optional clickable) &body body)
   (let ((symbol-fun (toolbar-symbol-fun name)))
     `(progn
-       (pushnew ',name *toolbar-module-list*)
+       (pushnew (list ',name ,clickable) *toolbar-module-list*)
        (defun ,symbol-fun (toolbar module)
          ,@body))))
 
@@ -320,4 +331,13 @@
                      "Label"))
 
 
+(define-toolbar-module (clickable-clock t)
+  "The clock module (clickable)"
+  (multiple-value-bind (s m h)
+      (get-decoded-time)
+    (declare (ignore s))
+    (toolbar-draw-text toolbar (second module) (/ *toolbar-default-thickness* 2)
+                       (format nil "Click:~2,'0D:~2,'0D" h m))))
+
+
 (format t "done~%")
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index d7e3d01..242bc91 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -35,9 +35,11 @@
 	 (values 0 0 width height)))
     (t (values 0 0 width height))))
 
-(defmacro with-placement ((placement x y &optional (width 0) (height 0) (border-size *border-size*)) &body body)
+(defmacro with-placement ((placement x y &optional (width 0) (height 0) border-size) &body body)
   `(multiple-value-bind (,x ,y width height)
-       (get-placement-values ,placement ,width ,height ,border-size)
+       ,(if border-size
+            `(get-placement-values ,placement ,width ,height ,border-size)
+            `(get-placement-values ,placement ,width ,height))
      (declare (ignorable width height))
      ,@body))
 
@@ -70,7 +72,7 @@
 
 (defun top-right-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (values (- (xlib:screen-width *screen*) width (* border-size 2))
-	  0
+          0
           width height))
 
 
@@ -89,23 +91,23 @@
 
 (defun middle-right-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (values (- (xlib:screen-width *screen*) width (* border-size 2))
-	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))
+          (truncate (/ (- (xlib:screen-height *screen*) height) 2))
           width height))
 
 
 (defun bottom-left-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (values 0
-	  (- (xlib:screen-height *screen*) height (* border-size 2))
+          (- (xlib:screen-height *screen*) height (* border-size 2))
           width height))
 
 (defun bottom-middle-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
-	  (- (xlib:screen-height *screen*) height (* border-size 2))
+          (- (xlib:screen-height *screen*) height (* border-size 2))
           width height))
 
 (defun bottom-right-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (values (- (xlib:screen-width *screen*) width (* border-size 2))
-	  (- (xlib:screen-height *screen*) height (* border-size 2))
+          (- (xlib:screen-height *screen*) height (* border-size 2))
           width height))
 
 
@@ -239,8 +241,8 @@
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x border-size 1)
-              (+ y border-size 1)
+      (values (+ x border-size)
+              (+ y border-size)
               width height))))
 
 (defun top-middle-root-placement (&optional (width 0) (height 0) (border-size *border-size*))
@@ -248,15 +250,15 @@
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
       (values (+ x (truncate (/ (- w width) 2)))
-              (+ y border-size 1)
+              (+ y border-size)
               width height))))
 
 (defun top-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x (- w width border-size 1))
-              (+ y border-size 1)
+      (values (+ x (- w width border-size))
+              (+ y border-size)
               width height))))
 
 
@@ -265,7 +267,7 @@
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x border-size 1)
+      (values (+ x border-size)
               (+ y (truncate (/ (- h height) 2)))
               width height))))
 
@@ -274,15 +276,15 @@
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-    (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y (truncate (/ (- h height) 2)))
-            width height))))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 (defun middle-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x (- w width border-size 1))
+      (values (+ x (- w width border-size))
               (+ y (truncate (/ (- h height) 2)))
               width height))))
 
@@ -291,8 +293,8 @@
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x border-size 1)
-              (+ y (- h height border-size 1))
+      (values (+ x border-size)
+              (+ y (- h height border-size))
               width height))))
 
 (defun bottom-middle-root-placement (&optional (width 0) (height 0) (border-size *border-size*))
@@ -300,14 +302,14 @@
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
       (values (+ x (truncate (/ (- w width) 2)))
-              (+ y (- h height border-size 1))
+              (+ y (- h height border-size))
               width height))))
 
 (defun bottom-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*))
   (with-current-root-coord (x y w h)
     (let ((width (min (- w 4) width))
           (height (min (- h 4) height)))
-      (values (+ x (- w width border-size 1))
-              (+ y (- h height border-size 1))
+      (values (+ x (- w width border-size))
+              (+ y (- h height border-size))
               width height))))
 
-- 
2.11.4.GIT