[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-46-g7e8581d
Philippe Brochard
pbrochard at common-lisp.net
Fri May 18 21:06:01 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 7e8581d49cf750448628d8bebe3db5be96914efb (commit)
from 0eb8c3465bd8baadeeef7ca426eba63f74e35400 (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 7e8581d49cf750448628d8bebe3db5be96914efb
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Fri May 18 23:05:53 2012 +0200
src/clfswm-placement.lisp: New root placement possibility.
diff --git a/ChangeLog b/ChangeLog
index 8e29683..27dd28f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
2012-05-18 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-placement.lisp: New root placement possibility.
+
* src/clfswm-util.lisp (change-current-root-geometry): New
function.
diff --git a/contrib/volume-mode.lisp b/contrib/volume-mode.lisp
index 83b7aae..752663c 100644
--- a/contrib/volume-mode.lisp
+++ b/contrib/volume-mode.lisp
@@ -63,7 +63,7 @@
(format t "Loading Volume mode code... ")
(defparameter *volume-keys* nil)
-(defconfig *volume-mode-placement* 'bottom-middle-placement
+(defconfig *volume-mode-placement* 'bottom-middle-root-placement
'Placement "Volume mode window placement")
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 8aa4c0b..44bb756 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -180,3 +180,78 @@
(with-current-child-coord (x y w h)
(values (+ x (- w width 2))
(+ y (- h height 2)))))
+
+
+;;;
+;;; Current root placement
+;;;
+(defun current-root-coord ()
+ (let ((root (find-root (current-child))))
+ (values (root-x root) (root-y root)
+ (root-w root) (root-h root))))
+
+
+(defmacro with-current-root-coord ((x y w h) &body body)
+ `(multiple-value-bind (,x ,y ,w ,h)
+ (current-root-coord)
+ , at body))
+
+
+(defun top-left-root-placement (&optional (width 0) (height 0))
+ (declare (ignore width height))
+ (with-current-root-coord (x y w h)
+ (declare (ignore w h))
+ (values (+ x 2)
+ (+ y 2))))
+
+(defun top-middle-root-placement (&optional (width 0) (height 0))
+ (declare (ignore height))
+ (with-current-root-coord (x y w h)
+ (declare (ignore h))
+ (values (+ x (truncate (/ (- w width) 2)))
+ (+ y 2))))
+
+(defun top-right-root-placement (&optional (width 0) (height 0))
+ (declare (ignore height))
+ (with-current-root-coord (x y w h)
+ (declare (ignore h))
+ (values (+ x (- w width 2))
+ (+ y 2))))
+
+
+
+(defun middle-left-root-placement (&optional (width 0) (height 0))
+ (declare (ignore width))
+ (with-current-root-coord (x y w h)
+ (declare (ignore w))
+ (values (+ x 2)
+ (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-middle-root-placement (&optional (width 0) (height 0))
+ (with-current-root-coord (x y w h)
+ (values (+ x (truncate (/ (- w width) 2)))
+ (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-right-root-placement (&optional (width 0) (height 0))
+ (with-current-root-coord (x y w h)
+ (values (+ x (- w width 2))
+ (+ y (truncate (/ (- h height) 2))))))
+
+
+(defun bottom-left-root-placement (&optional (width 0) (height 0))
+ (declare (ignore width))
+ (with-current-root-coord (x y w h)
+ (declare (ignore w))
+ (values (+ x 2)
+ (+ y (- h height 2)))))
+
+(defun bottom-middle-root-placement (&optional (width 0) (height 0))
+ (with-current-root-coord (x y w h)
+ (values (+ x (truncate (/ (- w width) 2)))
+ (+ y (- h height 2)))))
+
+(defun bottom-right-root-placement (&optional (width 0) (height 0))
+ (with-current-root-coord (x y w h)
+ (values (+ x (- w width 2))
+ (+ y (- h height 2)))))
+
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 6a51df7..9bbd8e8 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -155,6 +155,7 @@
(multiple-value-bind (x2 y2) (xlib:query-pointer *root*)
(exchange-root-geometry (find-root-by-coordinates x1 y1)
(find-root-by-coordinates x2 y2))))
+ (show-all-children)
(leave-second-mode))
(defun change-current-root-geometry ()
@@ -166,7 +167,8 @@
(h (query-number "New root height" (root-h root))))
(setf (root-x root) x (root-y root) y
(root-w root) w (root-h root) h)
- (show-all-children)))
+ (show-all-children)
+ (leave-second-mode)))
diff --git a/src/package.lisp b/src/package.lisp
index a301749..b06f767 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -216,30 +216,31 @@ loading configuration file and before opening the display.")
;;; Placement variables. A list of two absolute coordinates
;;; or a function: 'Y-X-placement' for absolute placement or
-;;; 'Y-X-child-placement' for child relative placement.
+;;; 'Y-X-child-placement' for child relative placement or
+;;; 'Y-X-root-placement' for root relative placement.
;;; Where Y-X are one of:
;;;
;;; top-left top-middle top-right
;;; middle-left middle-middle middle-right
;;; bottom-left bottom-middle bottom-right
;;;
-(defconfig *banish-pointer-placement* 'bottom-right-child-placement
+(defconfig *banish-pointer-placement* 'bottom-right-root-placement
'Placement "Pointer banishment placement")
-(defconfig *second-mode-placement* 'top-middle-child-placement
+(defconfig *second-mode-placement* 'top-middle-root-placement
'Placement "Second mode window placement")
-(defconfig *info-mode-placement* 'top-left-child-placement
+(defconfig *info-mode-placement* 'top-left-root-placement
'Placement "Info mode window placement")
-(defconfig *query-mode-placement* 'top-left-child-placement
+(defconfig *query-mode-placement* 'top-left-root-placement
'Placement "Query mode window placement")
-(defconfig *circulate-mode-placement* 'bottom-middle-child-placement
+(defconfig *circulate-mode-placement* 'bottom-middle-root-placement
'Placement "Circulate mode window placement")
-(defconfig *expose-mode-placement* 'top-left-child-placement
+(defconfig *expose-mode-placement* 'top-left-root-placement
'Placement "Expose mode window placement (Selection keys position)")
-(defconfig *notify-window-placement* 'bottom-right-child-placement
+(defconfig *notify-window-placement* 'bottom-right-root-placement
'Placement "Notify window placement")
-(defconfig *ask-close/kill-placement* 'top-right-child-placement
+(defconfig *ask-close/kill-placement* 'top-right-root-placement
'Placement "Ask close/kill window placement")
-(defconfig *unmanaged-window-placement* 'middle-middle-child-placement
+(defconfig *unmanaged-window-placement* 'middle-middle-root-placement
'Placement "Unmanager window placement")
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 2 +
contrib/volume-mode.lisp | 2 +-
src/clfswm-placement.lisp | 75 +++++++++++++++++++++++++++++++++++++++++++++
src/clfswm-util.lisp | 4 ++-
src/package.lisp | 21 ++++++------
5 files changed, 92 insertions(+), 12 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list