[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-63-g92c06b8
Philippe Brochard
pbrochard at common-lisp.net
Tue Jun 12 20:13:18 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 92c06b8c12a4e3cf3adfd9868ad16974a0fe604c (commit)
from f9c2f34e12e8ff76170edc0732514dcc61362938 (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 92c06b8c12a4e3cf3adfd9868ad16974a0fe604c
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue Jun 12 22:13:10 2012 +0200
contrib/toolbar.lisp: beginning of clickable modules
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)
, at 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))
, at 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))))
-----------------------------------------------------------------------
Summary of changes:
contrib/toolbar.lisp | 38 ++++++++++++++++++++++++++++--------
src/clfswm-placement.lisp | 46 +++++++++++++++++++++++---------------------
2 files changed, 53 insertions(+), 31 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list