From pbrochard at common-lisp.net  Fri May  4 19:46:03 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 04 May 2012 12:46:03 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-33-gaacece7
Message-ID: <E1SQOS3-0007Ef-W0@common-lisp.net>

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, master has been updated
       via  aacece7d7b5b312d54104ecc32a10efe1c231cd3 (commit)
      from  4b41ede4606956b7d072d5f9f1e92b01db4824f6 (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 aacece7d7b5b312d54104ecc32a10efe1c231cd3
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Fri May 4 21:45:56 2012 +0200

    src/*.lisp: replace find-current-root by find-related-root when needed

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index d99ea03..e1111fe 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1291,7 +1291,7 @@ For window: set current child to window or its parent according to window-parent
         (when (child-root-p child)
           (change-root child (find-parent-frame child)))
         (when (child-equal-p child *current-child*)
-          (setf *current-child* (find-current-root)))
+          (setf *current-child* (find-related-root child)))
         t)))
 
 
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index bb642e3..ff978fd 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -58,12 +58,13 @@
     (xlib:with-state (window)
       (when (has-bw value-mask)
 	(setf (x-drawable-border-width window) border-width))
-      (if (find-child window (find-current-root))
-	  (let ((parent (find-parent-frame window (find-current-root))))
-	    (if (and parent (managed-window-p window parent))
-		(adapt-child-to-parent window parent)
-		(adjust-from-request)))
-	  (adjust-from-request))
+      (let ((current-root (find-current-root)))
+        (if (find-child window current-root)
+            (let ((parent (find-parent-frame window current-root)))
+              (if (and parent (managed-window-p window parent))
+                  (adapt-child-to-parent window parent)
+                  (adjust-from-request)))
+            (adjust-from-request)))
       (send-configuration-notify window (x-drawable-x window) (x-drawable-y window)
 				 (x-drawable-width window) (x-drawable-height window)
 				 (x-drawable-border-width window))

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

Summary of changes:
 src/clfswm-internal.lisp |    2 +-
 src/clfswm.lisp          |   13 +++++++------
 2 files changed, 8 insertions(+), 7 deletions(-)


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



From pbrochard at common-lisp.net  Fri May  4 19:47:53 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 04 May 2012 12:47:53 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test created. R-1106-33-gaacece7
Message-ID: <E1SQOTp-0007Qy-7k@common-lisp.net>

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 created
        at  aacece7d7b5b312d54104ecc32a10efe1c231cd3 (commit)

- Log -----------------------------------------------------------------
-----------------------------------------------------------------------


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



From pbrochard at common-lisp.net  Sat May  5 22:14:22 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 05 May 2012 15:14:22 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-34-g8160ce9
Message-ID: <E1SQnF8-00049G-HQ@common-lisp.net>

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  8160ce9cd41e71d3106dfcda1c24c42fc5d43149 (commit)
      from  aacece7d7b5b312d54104ecc32a10efe1c231cd3 (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 8160ce9cd41e71d3106dfcda1c24c42fc5d43149
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 6 00:14:15 2012 +0200

    src/clfswm-internal.lisp : Use only one list for root	management.

diff --git a/ChangeLog b/ChangeLog
index eb14f2c..e836e42 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-06  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp : Use only one list for root
+	management.
+
 2012-04-30  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp: Big change to replace *current-root*
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index e1111fe..9897c98 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -84,15 +84,19 @@
 
 
 ;;; in-*: Find if point (x,y) is in frame, window or child
+(defun in-rect (x y xr yr wr hr)
+  (and (<= xr x (+ xr wr))
+       (<= yr y (+ yr hr))))
+
 (defun in-frame (frame x y)
   (and (frame-p frame)
-       (<= (frame-rx frame) x (+ (frame-rx frame) (frame-rw frame)))
-       (<= (frame-ry frame) y (+ (frame-ry frame) (frame-rh frame)))))
+       (in-rect x y (frame-rx frame) (frame-ry frame) (frame-rw frame) (frame-rh frame))))
 
 (defun in-window (window x y)
   (and (xlib:window-p window)
-       (<= (x-drawable-x window) x (+ (x-drawable-x window) (x-drawable-width window)))
-       (<= (x-drawable-y window) y (+ (x-drawable-y window) (x-drawable-height window)))))
+       (in-rect x y
+                (x-drawable-x window) (x-drawable-y window)
+                (x-drawable-width window) (x-drawable-height window))))
 
 (defgeneric in-child (child x y))
 
@@ -614,13 +618,16 @@
 
 
 ;;; Multiple roots support (replace the old *current-root* variable)
-(let ((root-list nil)
-      (original-root-list nil))
+(let ((root-list nil))
   ;; TODO: Add find-root-by-coordinates, change-root-geometry
 
   (defun define-as-root (child x y width height)
-    (push (make-root :child child :x x :y y :w width :h height) root-list)
-    (push (make-root :child child :x x :y y :w width :h height) original-root-list))
+    (push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
+
+  (defun find-root-by-coordinates (x y)
+    (dolist (root root-list)
+      (when (in-rect x y (root-x root) (root-y root) (root-w root) (root-h root))
+        (return root))))
 
   (defun all-root-child ()
     (loop for root in root-list
@@ -643,13 +650,13 @@
           (find-root it))))
 
   (defun find-original-root (child)
-    (dolist (root original-root-list)
-      (when (find-child child (root-child root))
+    (dolist (root root-list)
+      (when (find-child child (root-original root))
         (return-from find-original-root root))))
 
   (defun child-is-original-root-p (child)
-    (dolist (root original-root-list)
-      (when (child-equal-p child (root-child root))
+    (dolist (root root-list)
+      (when (child-equal-p child (root-original root))
         (return-from child-is-original-root-p t))))
 
   (defun find-root-in-child (child)
@@ -1263,13 +1270,13 @@ For window: set current child to window or its parent according to window-parent
 
 (defun switch-to-root-frame (&key (show-later nil))
   "Switch to the root frame"
-  (change-root (find-root *current-child*) (root-child (find-original-root *current-child*)))
+  (change-root (find-root *current-child*) (root-original (find-original-root *current-child*)))
   (unless show-later
     (show-all-children t)))
 
 (defun switch-and-select-root-frame (&key (show-later nil))
   "Switch and select the root frame"
-  (let ((new-root (root-child (find-original-root *current-child*))))
+  (let ((new-root (root-original (find-original-root *current-child*))))
     (change-root (find-root *current-child*) new-root)
     (setf *current-child* new-root))
   (unless show-later
diff --git a/src/package.lisp b/src/package.lisp
index d25600d..e4934ab 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -118,7 +118,7 @@ It is particulary useful with CLISP/MIT-CLX.")
 
 (defstruct child-rect child parent selected-p x y w h)
 
-(defstruct root child x y w h)
+(defstruct root child original current-child x y w h)
 
 (defclass frame ()
   ((name :initarg :name :accessor frame-name :initform nil)

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

Summary of changes:
 ChangeLog                |    5 +++++
 src/clfswm-internal.lisp |   35 +++++++++++++++++++++--------------
 src/package.lisp         |    2 +-
 3 files changed, 27 insertions(+), 15 deletions(-)


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



From pbrochard at common-lisp.net  Sun May  6 21:52:19 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 06 May 2012 14:52:19 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-35-g9ef2d64
Message-ID: <E1SR9NL-00080h-2v@common-lisp.net>

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  9ef2d64b8604f31de5f629eafb870502ee9f493a (commit)
      from  8160ce9cd41e71d3106dfcda1c24c42fc5d43149 (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 9ef2d64b8604f31de5f629eafb870502ee9f493a
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 6 23:52:10 2012 +0200

    src/clfswm-internal.lisp (*root*): Root management API simplification.

diff --git a/ChangeLog b/ChangeLog
index e836e42..dfbca59 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,7 @@
 
 	* src/clfswm-internal.lisp : Use only one list for root
 	management.
+	(*root*): Root management API simplification.
 
 2012-04-30  Philippe Brochard  <pbrochard at common-lisp.net>
 
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index c623e19..a5b189e 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -98,7 +98,7 @@
 		  *current-child* (frame-selected-child *circulate-parent*))))
         (when (and (not (child-root-p *current-child*))
                    (child-root-p old-child))
-          (change-root old-child *current-child*))))
+          (change-root (find-root old-child) *current-child*))))
     (show-all-children t)
     (draw-circulate-mode-window)))
 
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 9897c98..e8b380a 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -633,67 +633,33 @@
     (loop for root in root-list
        collect (root-child root)))
 
-  (defun child-root-p (child)
-    (dolist (root root-list)
-      (when (child-equal-p child (root-child root))
-        (return root))))
+  (labels ((generic-child-root-p (child function)
+             (dolist (root root-list)
+               (when (child-equal-p child (funcall function root))
+                 (return root)))))
+    (defun child-root-p (child)
+      (generic-child-root-p child #'root-child))
 
-  (defun change-root (old new)
-    (let ((root (child-root-p old)))
-      (when (and root new)
-        (setf (root-child root) new))))
+    (defun child-original-root-p (child)
+      (generic-child-root-p child #'root-original)))
+
+  (defun change-root (old-root new-child)
+    (when (and old-root new-child)
+      (setf (root-child old-root) new-child)))
 
   (defun find-root (child)
-    (if (child-root-p child)
-        child
+    (aif (child-original-root-p child)
+        it
         (awhen (find-parent-frame child)
           (find-root it))))
 
-  (defun find-original-root (child)
-    (dolist (root root-list)
-      (when (find-child child (root-original root))
-        (return-from find-original-root root))))
-
-  (defun child-is-original-root-p (child)
-    (dolist (root root-list)
-      (when (child-equal-p child (root-original root))
-        (return-from child-is-original-root-p t))))
-
-  (defun find-root-in-child (child)
-    (if (child-root-p child)
-        child
-        (when (frame-p child)
-          (dolist (c (frame-child child))
-            (awhen (find-root-in-child c)
-              (return-from find-root-in-child it))))))
-
-  (defun find-all-root (child)
-    "Return a list of root in child"
-    (let ((roots nil))
-      (labels ((rec (child)
-                 (when (child-root-p child)
-                   (push child roots))
-                 (when (frame-p child)
-                   (dolist (c (frame-child child))
-                     (rec c)))))
-        (rec child)
-        roots)))
-
   (defun find-child-in-all-root (child)
     (dolist (root root-list)
       (when (find-child child (root-child root))
         (return-from find-child-in-all-root root))))
 
-  (defun only-one-root-in-p (child)
-    (<= (length (find-all-root child)) 1))
-
   (defun find-current-root ()
-    (find-root *current-child*))
-
-  (defun find-related-root (child)
-    (or (find-root-in-child child)
-        (find-root-in-child (root-child (find-original-root child))))))
-
+    (root-child (find-root *current-child*))))
 
 
 ;;; Multiple physical screen helper
@@ -734,8 +700,9 @@
         (progn
           (loop while (< (length (frame-child *root-frame*)) (length sizes))
              do (let ((frame (create-frame)))
-                  (add-frame frame *root-frame*)))
+                  (add-frame frame *root-frame*)
                   ;;(add-placed-frame-tmp frame 2)))
+                  ))
           (loop for size in sizes
              for frame in (frame-child *root-frame*)
              do (destructuring-bind (x y w h) size
@@ -1169,7 +1136,7 @@
   (let ((root (find-root child)))
     (when (and window-parent
                (not (child-root-p child))
-               (not (find-child parent root)))
+               (not (find-child parent (root-child root))))
       (change-root root parent)
       t)))
 
@@ -1205,17 +1172,17 @@ For window: set current child to window or its parent according to window-parent
 (defun enter-frame ()
   "Enter in the selected frame - ie make it the root frame"
   (let ((root (find-root *current-child*)))
-    (unless (child-equal-p root *current-child*)
+    (unless (child-equal-p (root-child root) *current-child*)
       (change-root root *current-child*))
     (show-all-children t)))
 
 (defun leave-frame ()
   "Leave the selected frame - ie make its parent the root frame"
   (let ((root (find-root *current-child*)))
-    (unless (child-equal-p root *root-frame*)
-      (awhen (find-parent-frame root)
-        (when (and (frame-p it)
-                   (only-one-root-in-p it))
+    (unless (or (child-equal-p (root-child root) *root-frame*)
+                (child-original-root-p (root-child root)))
+      (awhen (and root (find-parent-frame (root-child root)))
+        (when (frame-p it)
           (change-root root it)))
       (show-all-children))))
 
@@ -1270,15 +1237,16 @@ For window: set current child to window or its parent according to window-parent
 
 (defun switch-to-root-frame (&key (show-later nil))
   "Switch to the root frame"
-  (change-root (find-root *current-child*) (root-original (find-original-root *current-child*)))
+  (let ((root (find-root *current-child*)))
+    (change-root root (root-original root)))
   (unless show-later
     (show-all-children t)))
 
 (defun switch-and-select-root-frame (&key (show-later nil))
   "Switch and select the root frame"
-  (let ((new-root (root-original (find-original-root *current-child*))))
-    (change-root (find-root *current-child*) new-root)
-    (setf *current-child* new-root))
+  (let ((root (find-root *current-child*)))
+    (change-root root (root-original root))
+    (setf *current-child* (root-original root)))
   (unless show-later
     (show-all-children t)))
 
@@ -1292,13 +1260,13 @@ For window: set current child to window or its parent according to window-parent
 
 (defun prevent-current-*-equal-child (child)
   " Prevent current-root and current-child equal to child"
-  (if (child-is-original-root-p child)
+  (if (child-original-root-p child)
       nil
       (progn
-        (when (child-root-p child)
-          (change-root child (find-parent-frame child)))
+        (awhen (child-root-p child)
+          (change-root it (find-parent-frame child)))
         (when (child-equal-p child *current-child*)
-          (setf *current-child* (find-related-root child)))
+          (setf *current-child* (root-child (find-root child))))
         t)))
 
 
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index 99355a2..a307824 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -47,7 +47,7 @@
 		   (find-parent-frame *current-child*)
 		   *current-child*)))
     (unless (or (child-member frame *permanent-nw-hook-frames*)
-                (child-is-original-root-p frame))
+                (child-original-root-p frame))
       (setf (frame-nw-hook frame) hook)
       (leave-second-mode))))
 
@@ -171,7 +171,7 @@
     (when parent
       (pushnew new-frame (frame-child parent))
       (pushnew window (frame-child new-frame))
-      (change-root (find-related-root parent) parent)
+      (change-root (find-root parent) parent)
       (setf *current-child* parent)
       (set-layout-once #'tile-space-layout)
       (setf *current-child* new-frame)
@@ -214,7 +214,7 @@
   (when (frame-p frame)
     (pushnew window (frame-child frame))
     (unless (find-child-in-all-root frame)
-      (change-root (find-related-root frame) frame))
+      (change-root (find-root frame) frame))
     (setf *current-child* frame)
     (focus-all-children window frame)
     (default-window-placement frame window)
@@ -260,7 +260,7 @@
       (pushnew window (frame-child frame))
       (unless *in-process-existing-windows*
 	(unless (find-child-in-all-root frame)
-          (change-root (find-related-root frame) frame))
+          (change-root (find-root frame) frame))
 	(setf *current-child* frame)
 	(focus-all-children window frame)
 	(default-window-placement frame window)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 45fdc22..34cebcc 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -114,16 +114,16 @@
 
 (defun add-frame-in-parent-frame ()
   "Add a frame in the parent frame (and reorganize parent frame)"
-  (let ((new-frame (create-frame))
-	(parent (find-parent-frame *current-child*)))
-    (when (and parent (only-one-root-in-p parent))
-      (pushnew new-frame (frame-child parent))
-      (when (child-root-p *current-child*)
-        (change-root *current-child* parent))
-      (setf *current-child* parent)
-      (set-layout-once #'tile-space-layout)
-      (setf *current-child* new-frame)
-      (leave-second-mode))))
+  (let ((parent (find-parent-frame *current-child*)))
+    (when (and parent (not (child-original-root-p *current-child*)))
+      (let ((new-frame (create-frame)))
+        (pushnew new-frame (frame-child parent))
+        (awhen (child-root-p *current-child*)
+          (change-root it parent))
+        (setf *current-child* parent)
+        (set-layout-once #'tile-space-layout)
+        (setf *current-child* new-frame)
+        (leave-second-mode)))))
 
 
 
@@ -769,7 +769,7 @@ For window: set current child to window or its parent according to window-parent
     (let ((jump-child (aref key-slots current-slot)))
       (when (find-child jump-child *root-frame*)
         (unless (find-child-in-all-root jump-child)
-          (change-root (find-related-root jump-child) jump-child))
+          (change-root (find-root jump-child) jump-child))
 	(setf *current-child* jump-child)
 	(focus-all-children *current-child* *current-child*)
 	(show-all-children t))))
@@ -1176,7 +1176,7 @@ For window: set current child to window or its parent according to window-parent
     "Store the current child and switch to the previous one"
     (let ((current-child *current-child*))
       (when last-child
-        (change-root (find-related-root last-child) last-child)
+        (change-root (find-root last-child) last-child)
         (setf *current-child* last-child)
 	(focus-all-children *current-child* *current-child*)
 	(show-all-children t))
@@ -1613,7 +1613,7 @@ For window: set current child to window or its parent according to window-parent
           (setf *current-child* parent)
 	  (put-child-on-top window parent)
           (when maximized
-            (change-root (find-related-root parent) parent))
+            (change-root (find-root parent) parent))
 	  (focus-all-children window parent)
           (show-all-children t))
         (funcall run-fn))))

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

Summary of changes:
 ChangeLog                      |    1 +
 src/clfswm-circulate-mode.lisp |    2 +-
 src/clfswm-internal.lisp       |   96 +++++++++++++--------------------------
 src/clfswm-nw-hooks.lisp       |    8 ++--
 src/clfswm-util.lisp           |   26 +++++-----
 5 files changed, 51 insertions(+), 82 deletions(-)


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



From pbrochard at common-lisp.net  Tue May  8 22:36:40 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 08 May 2012 15:36:40 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-36-gbf200cb
Message-ID: <E1SRt1M-0001NA-Ow@common-lisp.net>

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  bf200cb2092db5bfa72076914fdc9d3a8ceb07c0 (commit)
      from  9ef2d64b8604f31de5f629eafb870502ee9f493a (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 bf200cb2092db5bfa72076914fdc9d3a8ceb07c0
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed May 9 00:36:30 2012 +0200

    src/clfswm-internal.lisp: Use xdpyinfo/xinerama informations instead of xrandr informations.

diff --git a/ChangeLog b/ChangeLog
index dfbca59..9d0f0d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-09  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp: Use xdpyinfo/xinerama informations
+	instead of xrandr informations.
+
 2012-05-06  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp : Use only one list for root
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index e8b380a..f270463 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -624,6 +624,11 @@
   (defun define-as-root (child x y width height)
     (push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
 
+  (defun unsure-at-least-one-root ()
+    (unless root-list
+      (define-as-root *root-frame* (- *border-size*) (- *border-size*)
+                      (xlib:screen-width *screen*) (xlib:screen-height *screen*))))
+
   (defun find-root-by-coordinates (x y)
     (dolist (root root-list)
       (when (in-rect x y (root-x root) (root-y root) (root-w root) (root-h root))
@@ -663,35 +668,36 @@
 
 
 ;;; Multiple physical screen helper
-(defun get-xrandr-connected-size ()
-  (let ((output (do-shell "xrandr"))
-        (sizes '()))
-    (loop for line = (read-line output nil nil)
-       while line
-       do
-         (awhen (search " connected " line)
-           (incf it (length " connected "))
-           (destructuring-bind (w h x y)
-               (mapcar #'parse-integer
-                       (split-string (substitute #\space #\x
-                                                 (substitute #\space #\+
-                                                             (subseq line it (position #\space line :start it))))))
-             (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
-    (dbg sizes)
-    sizes))
-    ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250))))  ;;; For test
-
-(defun add-placed-frame-tmp (frame n)
+(defun add-placed-frame-tmp (frame n)   ;; For test
   (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame)
   (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame)
   (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame)
   (when (plusp n)
     (add-placed-frame-tmp (first (frame-child frame)) (1- n))))
 
-
-(defun place-frames-from-xrandr ()
-  "Place frames according to xrandr informations"
-  (let ((sizes (get-xrandr-connected-size))
+(defun parse-xinerama-info (line)
+  (remove nil
+          (mapcar (lambda (string)
+                    (parse-integer string :junk-allowed t))
+                  (split-string (substitute #\space #\x (substitute #\space #\, line))))))
+
+(defun get-connected-heads-size ()
+  (when (xlib:query-extension *display* "XINERAMA")
+    (let ((output (do-shell "xdpyinfo -ext XINERAMA"))
+          (sizes '()))
+      (loop for line = (read-line output nil nil)
+         while line
+         do (when (search " head " line)
+              (destructuring-bind (w h x y)
+                  (parse-xinerama-info line)
+                (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
+      (remove-duplicates sizes :test #'equal))))
+  ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250))))  ;;; For test
+
+
+(defun place-frames-from-xinerama-infos ()
+  "Place frames according to xdpyinfo/xinerama informations"
+  (let ((sizes (get-connected-heads-size))
         (width (xlib:screen-width *screen*))
         (height (xlib:screen-height *screen*)))
     ;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
@@ -700,9 +706,8 @@
         (progn
           (loop while (< (length (frame-child *root-frame*)) (length sizes))
              do (let ((frame (create-frame)))
-                  (add-frame frame *root-frame*)
                   ;;(add-placed-frame-tmp frame 2)))
-                  ))
+                  (add-frame frame *root-frame*)))
           (loop for size in sizes
              for frame in (frame-child *root-frame*)
              do (destructuring-bind (x y w h) size
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index ff978fd..acb0a47 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -218,6 +218,7 @@
         *current-root* *root-frame*  ;;; PHIL: TO REMOVE
 	*current-child* *root-frame*)
   (call-hook *init-hook*)
+  (unsure-at-least-one-root)
   (process-existing-windows *screen*)
   (show-all-children)
   (grab-main-keys)
diff --git a/src/config.lisp b/src/config.lisp
index 253b037..1db5f51 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -159,7 +159,9 @@ This command must set the window title to *clfswm-terminal-name*")
 ;;;
 ;;; See clfswm.lisp for hooks examples.
 
-(defconfig *init-hook* '(default-init-hook place-frames-from-xrandr display-hello-window)
+(defconfig *init-hook* '(default-init-hook
+                         place-frames-from-xinerama-infos
+                         display-hello-window)
   'Hook "Init hook. This hook is run just after the first root frame is created")
 
 (defconfig *close-hook* '(close-notify-window close-clfswm-terminal close-virtual-keyboard)

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

Summary of changes:
 ChangeLog                |    5 ++++
 src/clfswm-internal.lisp |   55 +++++++++++++++++++++++++---------------------
 src/clfswm.lisp          |    1 +
 src/config.lisp          |    4 ++-
 4 files changed, 39 insertions(+), 26 deletions(-)


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



From pbrochard at common-lisp.net  Sat May 12 20:29:52 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 12 May 2012 13:29:52 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-36-gbf200cb
Message-ID: <E1STIwq-0002Hz-15@common-lisp.net>

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, master has been updated
       via  bf200cb2092db5bfa72076914fdc9d3a8ceb07c0 (commit)
       via  9ef2d64b8604f31de5f629eafb870502ee9f493a (commit)
       via  8160ce9cd41e71d3106dfcda1c24c42fc5d43149 (commit)
      from  aacece7d7b5b312d54104ecc32a10efe1c231cd3 (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 -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                      |   11 +++
 src/clfswm-circulate-mode.lisp |    2 +-
 src/clfswm-internal.lisp       |  170 ++++++++++++++++++----------------------
 src/clfswm-nw-hooks.lisp       |    8 +-
 src/clfswm-util.lisp           |   26 +++---
 src/clfswm.lisp                |    1 +
 src/config.lisp                |    4 +-
 src/package.lisp               |    2 +-
 8 files changed, 109 insertions(+), 115 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 13 21:27:09 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 13 May 2012 14:27:09 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-37-g793638d
Message-ID: <E1STgJp-0000M0-Ic@common-lisp.net>

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  793638d4c961bf53cbfa04157e6f6655c2b26979 (commit)
      from  bf200cb2092db5bfa72076914fdc9d3a8ceb07c0 (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 793638d4c961bf53cbfa04157e6f6655c2b26979
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 13 23:27:01 2012 +0200

    src/clfswm-internal.lisp: Remove the *current-child* variable and use a setfable function (current-child) instead.

diff --git a/ChangeLog b/ChangeLog
index 9d0f0d9..de5e677 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp: Remove the *current-child* variable
+	and use a setfable function (current-child) instead.
+
 2012-05-09  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp: Use xdpyinfo/xinerama informations
diff --git a/clfswm.asd b/clfswm.asd
index c11942d..98ef92e 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -19,12 +19,10 @@
 				:depends-on ("tools"))
 			 (:file "package"
 				:depends-on ("my-html" "tools" "version"))
-			 (:file "clfswm-placement"
-				:depends-on ("package"))
 			 (:file "keysyms"
 				:depends-on ("package"))
 			 (:file "xlib-util"
-				:depends-on ("package" "keysyms" "tools" "clfswm-placement"))
+				:depends-on ("package" "keysyms" "tools"))
 			 (:file "config"
 				:depends-on ("package" "xlib-util"))
 			 (:file "netwm-util"
@@ -35,6 +33,8 @@
 				:depends-on ("package" "clfswm-keys" "my-html" "tools" "config"))
 			 (:file "clfswm-internal"
 				:depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools" "config"))
+                         (:file "clfswm-placement"
+				:depends-on ("package" "clfswm-internal"))
 			 (:file "clfswm-generic-mode"
 				:depends-on ("package" "tools" "xlib-util" "clfswm-internal"))
 			 (:file "clfswm-circulate-mode"
@@ -61,7 +61,8 @@
 						       "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-util"
 				:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query"
-                                                      "clfswm-menu" "clfswm-autodoc" "clfswm-corner"))
+                                                      "clfswm-menu" "clfswm-autodoc" "clfswm-corner"
+                                                      "clfswm-placement"))
                          (:file "clfswm-configuration"
 				:depends-on ("package" "config" "clfswm-internal" "clfswm-util" "clfswm-query"
 						       "clfswm-menu"))
diff --git a/contrib/osd.lisp b/contrib/osd.lisp
index 24581af..ecba461 100644
--- a/contrib/osd.lisp
+++ b/contrib/osd.lisp
@@ -75,7 +75,7 @@
     (map-window *osd-window*))
   (let* ((modifiers (state->modifiers state))
 	 (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
-    (when (frame-p *current-child*)
+    (when (frame-p (current-child))
       (push (list #'is-osd-window-p nil) *never-managed-window-list*))
     (raise-window *osd-window*)
     (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
diff --git a/contrib/server/test.lisp b/contrib/server/test.lisp
index 59755e9..da7d3ea 100755
--- a/contrib/server/test.lisp
+++ b/contrib/server/test.lisp
@@ -4,10 +4,10 @@
 (select-previous-level)
 
 (let ((frame (create-frame \:name \"Test root\" \:x 0.05 \:y 0.05)))
-  (add-frame frame *current-child*)
+  (add-frame frame (current-child))
   (add-frame (create-frame \:name \"Test 1\" \:x 0.3 \:y 0 \:w 0.7 \:h 1) frame)
   (add-frame (create-frame \:name \"Test 2\" \:x 0 \:y 0 \:w 0.3 \:h 1) frame)
-  (setf *current-child* (first (frame-child frame))))
+  (setf (current-child) (first (frame-child frame))))
 
 (show-all-children *current-root*)
 
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index cdeea62..3e4964a 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -122,6 +122,9 @@
   (define-second-key ("h") 'rotate-frame-geometry)
   (define-second-key ("h" :shift) 'anti-rotate-frame-geometry)
 
+  (define-second-key ("Page_Up") 'select-next-root)
+  (define-second-key ("Page_Down") 'select-previous-root)
+
   (define-second-key ("Right") 'speed-mouse-right)
   (define-second-key ("Left") 'speed-mouse-left)
   (define-second-key ("Down") 'speed-mouse-down)
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index a5b189e..7e4be5e 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -39,7 +39,7 @@
   (let* ((text (format nil "~A [~A]"
 		       (limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
 				     *circulate-text-limite*)
-		       (limit-length (ensure-printable (child-name *current-child*))
+		       (limit-length (ensure-printable (child-name (current-child)))
 				     *circulate-text-limite*)))
 	 (len (length text)))
     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
@@ -59,10 +59,10 @@
 (defun reset-circulate-child ()
   (setf *circulate-hit* 0
 	*circulate-parent* nil
-	*circulate-orig* (frame-child *current-child*)))
+	*circulate-orig* (frame-child (current-child))))
 
 (defun reset-circulate-brother ()
-  (setf *circulate-parent* (find-parent-frame *current-child*)
+  (setf *circulate-parent* (find-parent-frame (current-child))
         *circulate-hit* 0)
   (when (frame-p *circulate-parent*)
     (setf *circulate-orig* (frame-child *circulate-parent*))))
@@ -71,7 +71,7 @@
 
 (defun reorder-child (direction)
   (no-focus)
-  (with-slots (child selected-pos) *current-child*
+  (with-slots (child selected-pos) (current-child)
     (unless *circulate-orig*
       (reset-circulate-child))
     (let ((len (length *circulate-orig*)))
@@ -85,27 +85,27 @@
 
 (defun reorder-brother (direction)
   (no-focus)
-  (let ((old-child *current-child*))
+  (let ((old-child (current-child)))
     (select-current-frame nil)
     (unless (and *circulate-orig* *circulate-parent*)
       (reset-circulate-brother))
     (let ((len (length *circulate-orig*)))
       (when (plusp len)
 	(when (frame-p *circulate-parent*)
-	  (let ((elem (nth (mod  (incf *circulate-hit* direction) len) *circulate-orig*)))
+	  (let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
 	    (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
                   (frame-selected-pos *circulate-parent*) 0
-		  *current-child* (frame-selected-child *circulate-parent*))))
-        (when (and (not (child-root-p *current-child*))
+		  (current-child) (frame-selected-child *circulate-parent*))))
+        (when (and (not (child-root-p (current-child)))
                    (child-root-p old-child))
-          (change-root (find-root old-child) *current-child*))))
+          (change-root (find-root old-child) (current-child)))))
     (show-all-children t)
     (draw-circulate-mode-window)))
 
 (defun reorder-subchild (direction)
   (declare (ignore direction))
-  (when (frame-p *current-child*)
-    (let ((selected-child (frame-selected-child *current-child*)))
+  (when (frame-p (current-child))
+    (let ((selected-child (frame-selected-child (current-child))))
       (when (frame-p selected-child)
 	(no-focus)
 	(with-slots (child selected-pos) selected-child
@@ -122,14 +122,14 @@
 
 (defun circulate-select-next-child ()
   "Select the next child"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (when *circulate-parent*
       (reset-circulate-child))
     (reorder-child +1)))
 
 (defun circulate-select-previous-child ()
   "Select the previous child"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (when *circulate-parent*
       (reset-circulate-child))
     (reorder-child -1)))
@@ -248,60 +248,60 @@
 
 (defun select-next-child ()
   "Select the next child"
-  (when (frame-p *current-child*)
-    (setf *circulate-orig* (frame-child *current-child*)
+  (when (frame-p (current-child))
+    (setf *circulate-orig* (frame-child (current-child))
 	  *circulate-parent* nil)
     (circulate-mode :child-direction +1)))
 
 (defun select-previous-child ()
   "Select the previous child"
-  (when (frame-p *current-child*)
-    (setf *circulate-orig* (frame-child *current-child*)
+  (when (frame-p (current-child))
+    (setf *circulate-orig* (frame-child (current-child))
 	  *circulate-parent* nil)
     (circulate-mode :child-direction -1)))
 
 
 (defun select-next-brother ()
   "Select the next brother"
-  (setf *circulate-parent* (find-parent-frame *current-child*))
+  (setf *circulate-parent* (find-parent-frame (current-child)))
   (when (frame-p *circulate-parent*)
     (setf *circulate-orig* (frame-child *circulate-parent*)))
   (circulate-mode :brother-direction +1))
 
 (defun select-previous-brother ()
   "Select the previous brother"
-  (setf *circulate-parent* (find-parent-frame *current-child*))
+  (setf *circulate-parent* (find-parent-frame (current-child)))
   (when (frame-p *circulate-parent*)
     (setf *circulate-orig* (frame-child *circulate-parent*)))
   (circulate-mode :brother-direction -1))
 
 (defun select-next-subchild ()
   "Select the next subchild"
-  (when (and (frame-p *current-child*)
-	     (frame-p (frame-selected-child *current-child*)))
-    (setf *circulate-orig* (frame-child *current-child*)
+  (when (and (frame-p (current-child))
+	     (frame-p (frame-selected-child (current-child))))
+    (setf *circulate-orig* (frame-child (current-child))
 	  *circulate-parent* nil)
     (circulate-mode :subchild-direction +1)))
 
 
 (defun select-next-child-simple ()
   "Select the next child (do not enter in circulate mode)"
-  (when (frame-p *current-child*)
-    (with-slots (child) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child) (current-child)
       (setf child (rotate-list child)))
     (show-all-children)))
 
 
 
 (defun reorder-brother-simple (reorder-fun)
-  (unless (child-root-p *current-child*)
+  (unless (child-root-p (current-child))
     (no-focus)
     (select-current-frame nil)
-    (let ((parent-frame (find-parent-frame *current-child*)))
+    (let ((parent-frame (find-parent-frame (current-child))))
       (when (frame-p parent-frame)
         (with-slots (child) parent-frame
           (setf child (funcall reorder-fun child)
-                *current-child* (frame-selected-child parent-frame))))
+                (current-child) (frame-selected-child parent-frame))))
       (show-all-children t))))
 
 
@@ -318,27 +318,27 @@
 ;;; Spatial move functions
 (defun select-brother-generic-spatial-move (fun-found)
   "Select the nearest brother of the current child based on the fun-found function"
-  (let ((is-root-p (child-root-p *current-child*)))
+  (let ((is-root-p (child-root-p (current-child))))
     (when is-root-p
       (leave-frame)
       (sleep *spatial-move-delay-before*))
     (no-focus)
     (select-current-frame nil)
-    (let ((parent-frame (find-parent-frame *current-child*)))
+    (let ((parent-frame (find-parent-frame (current-child))))
       (when (frame-p parent-frame)
         (with-slots (child selected-pos) parent-frame
           (let ((found nil)
                 (found-dist nil))
             (dolist (c child)
-              (let ((dist (funcall fun-found *current-child* c)))
+              (let ((dist (funcall fun-found (current-child) c)))
                 (when (and dist
-                           (not (child-equal-p *current-child* c))
+                           (not (child-equal-p (current-child) c))
                            (or (not found)
                                (and found-dist (< dist found-dist))))
                   (setf found c
                         found-dist dist))))
             (when found
-              (setf *current-child* found
+              (setf (current-child) found
                     selected-pos 0
                     child (cons found (child-remove found child)))))))
       (show-all-children t)
@@ -380,3 +380,23 @@
                                              (distance (middle-child-x current) (child-y current)
                                                        (middle-child-x child) (child-y2 child))))))
 
+
+
+
+(defun select-generic-root (fun)
+  (no-focus)
+  (let* ((current-root (find-root (current-child)))
+         (parent (find-parent-frame (root-original current-root))))
+    (setf (frame-child parent) (funcall fun (frame-child parent))
+          (current-child) (frame-selected-child parent)))
+  (show-all-children t)
+  (leave-second-mode))
+
+(defun select-next-root ()
+  "Select the next root"
+  (select-generic-root #'rotate-list))
+
+(defun select-previous-root ()
+  "Select the previous root"
+  (select-generic-root #'anti-rotate-list))
+
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index eae9406..60c63b7 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -106,7 +106,7 @@
 			 (third lwin))))
 
 (defun expose-create-window (child n)
-  (let* ((*current-child* child)
+  (let* (;;((current-child) child) ;;; PHIL: Broken
 	 (string (format nil "~A~A" (number->string n)
 			 (if *expose-show-window-title*
 			     (format nil " - ~A" (ensure-printable (child-fullname child)))
@@ -216,10 +216,10 @@
 (defun expose-windows-current-child-mode ()
   "Present all windows in the current child (An expose like)"
   (stop-button-event)
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (let ((orig-root *current-root*))
-      (unless (child-equal-p *current-child* *current-root*)
-	(setf *current-root* *current-child*))
+      (unless (child-equal-p (current-child) *current-root*)
+	(setf *current-root* (current-child)))
       (expose-windows-generic *current-root*
                               (lambda (parent)
                                 (setf *current-root* parent))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index f270463..d71b0ca 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -375,8 +375,8 @@
 
 
 (defun is-in-current-child-p (child)
-  (and (frame-p *current-child*)
-       (child-member child (frame-child *current-child*))))
+  (and (frame-p (current-child))
+       (child-member child (frame-child (current-child)))))
 
 
 
@@ -558,9 +558,9 @@
 
 (defun fixe-real-size-current-child ()
   "Fixe real (pixel) coordinates in float coordinates for children in the current child"
-  (when (frame-p *current-child*)
-    (dolist (child (frame-child *current-child*))
-      (fixe-real-size child *current-child*))))
+  (when (frame-p (current-child))
+    (dolist (child (frame-child (current-child)))
+      (fixe-real-size child (current-child)))))
 
 
 
@@ -616,10 +616,25 @@
 		 (rec parent)))))
     (rec base)))
 
-
 ;;; Multiple roots support (replace the old *current-root* variable)
-(let ((root-list nil))
-  ;; TODO: Add find-root-by-coordinates, change-root-geometry
+;; TODO: Add find-root-by-coordinates, change-root-geometry
+(let ((root-list nil)
+      (current-child nil))
+  (defun current-child ()
+    current-child)
+
+  (defun current-child-setter (value)
+    (setf current-child value))
+
+  (defmacro with-current-child ((new-child) &body body)
+    "Temporarly change the current child"
+    (let ((old-child (gensym))
+          (ret (gensym)))
+      `(let ((,old-child (current-child)))
+         (setf (current-child) ,new-child)
+         (let ((,ret (multiple-value-list (progn , at body))))
+           (setf (current-child) ,old-child)
+           (values-list ,ret)))))
 
   (defun define-as-root (child x y width height)
     (push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
@@ -654,9 +669,9 @@
 
   (defun find-root (child)
     (aif (child-original-root-p child)
-        it
-        (awhen (find-parent-frame child)
-          (find-root it))))
+         it
+         (awhen (find-parent-frame child)
+                (find-root it))))
 
   (defun find-child-in-all-root (child)
     (dolist (root root-list)
@@ -664,7 +679,10 @@
         (return-from find-child-in-all-root root))))
 
   (defun find-current-root ()
-    (root-child (find-root *current-child*))))
+    (root-child (find-root (current-child)))))
+
+(defsetf current-child current-child-setter)
+
 
 
 ;;; Multiple physical screen helper
@@ -681,18 +699,31 @@
                     (parse-integer string :junk-allowed t))
                   (split-string (substitute #\space #\x (substitute #\space #\, line))))))
 
-(defun get-connected-heads-size ()
-  (when (xlib:query-extension *display* "XINERAMA")
-    (let ((output (do-shell "xdpyinfo -ext XINERAMA"))
-          (sizes '()))
-      (loop for line = (read-line output nil nil)
-         while line
-         do (when (search " head " line)
-              (destructuring-bind (w h x y)
-                  (parse-xinerama-info line)
-                (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
-      (remove-duplicates sizes :test #'equal))))
-  ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250))))  ;;; For test
+(defun get-connected-heads-size (&optional (fake t))
+  (labels ((heads-info ()
+             (if (not fake)
+                 (do-shell "xdpyinfo -ext XINERAMA")
+                 (progn
+                   (setf *show-root-frame-p* t)
+                   (do-shell "echo '    available colormap entries:    256 per subfield
+    red, green, blue masks:    0xff0000, 0xff00, 0xff
+    significant bits in color specification:    8 bits
+
+XINERAMA version 1.1 opcode: 150
+  head #0: 500x300 @ 10,10
+  head #1: 480x300 @ 520,20
+  head #2: 600x250 @ 310,330'")))))
+    (when (xlib:query-extension *display* "XINERAMA")
+      (let ((output (heads-info))
+            (sizes nil))
+        (loop for line = (read-line output nil nil)
+           while line
+           do (when (search " head " line)
+                (destructuring-bind (w h x y)
+                    (parse-xinerama-info line)
+                  (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
+        (dbg sizes)
+        (remove-duplicates sizes :test #'equal)))))
 
 
 (defun place-frames-from-xinerama-infos ()
@@ -717,7 +748,7 @@
                         (frame-h frame) (float (/ h height)))
                   (add-frame (create-frame) frame)
                   (define-as-root frame x y w h)))
-          (setf *current-child* (first (frame-child (first (frame-child *root-frame*)))))))))
+          (setf (current-child) (first (frame-child (first (frame-child *root-frame*)))))))))
 
 
 
@@ -741,9 +772,9 @@
 
 ;;; Current window utilities
 (defun get-current-window ()
-  (typecase *current-child*
-    (xlib:window  *current-child*)
-    (frame (frame-selected-child *current-child*))))
+  (typecase (current-child)
+    (xlib:window  (current-child))
+    (frame (frame-selected-child (current-child)))))
 
 (defmacro with-current-window (&body body)
   "Bind 'window' to the current window"
@@ -752,10 +783,10 @@
 	, at body)))
 
 (defun get-first-window ()
-  (typecase *current-child*
-    (xlib:window  *current-child*)
-    (frame (or (first (frame-child *current-child*))
-               *current-child*))))
+  (typecase (current-child)
+    (xlib:window  (current-child))
+    (frame (or (first (frame-child (current-child)))
+               (current-child)))))
 
 
 
@@ -769,7 +800,7 @@
               (xlib:window-background window) (get-color *frame-background*))
         (clear-pixmap-buffer window gc)
         (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root-p frame)
-                                                                (child-equal-p frame *current-child*))
+                                                                (child-equal-p frame (current-child)))
                                                            *frame-foreground-root* *frame-foreground*)))
         (xlib:draw-glyphs *pixmap-buffer* gc 5 dy
                           (format nil "Frame: ~A~A"
@@ -913,9 +944,9 @@
 
 (defmethod show-child ((window xlib:window) parent previous)
   (if (or (managed-window-p window parent)
-	  (child-equal-p window *current-child*)
+	  (child-equal-p window (current-child))
 	  (not (hide-unmanaged-window-p parent))
-	  (child-equal-p parent *current-child*))
+	  (child-equal-p parent (current-child)))
       (progn
 	(map-window window)
 	(set-child-stack-order window previous))
@@ -943,7 +974,7 @@
 (defgeneric select-child (child selected))
 
 (labels ((get-selected-color (child selected-p)
-           (get-color (cond ((child-equal-p child *current-child*) *color-selected*)
+           (get-color (cond ((child-equal-p child (current-child)) *color-selected*)
                             (selected-p *color-maybe-selected*)
                             (t *color-unselected*)))))
   (defmethod select-child ((frame frame) selected-p)
@@ -960,7 +991,7 @@
     ()))
 
 (defun select-current-frame (selected)
-  (select-child *current-child* selected))
+  (select-child (current-child) selected))
 
 (defun unselect-all-frames ()
   (with-all-children (*root-frame* child)
@@ -974,7 +1005,7 @@
 	       (xlib:window (focus-window child))
 	       (frame (rec (frame-selected-child child))))))
     (no-focus)
-    (rec *current-child*)))
+    (rec (current-child))))
 
 
 
@@ -1118,8 +1149,8 @@
 
 
 (defun set-current-child-generic (child)
-  (unless (child-equal-p *current-child* child)
-    (setf *current-child* child)
+  (unless (child-equal-p (current-child) child)
+    (setf (current-child) child)
     t))
 
 (defgeneric set-current-child (child parent window-parent))
@@ -1160,30 +1191,30 @@ For window: set current child to window or its parent according to window-parent
 (defun select-next-level ()
   "Select the next level in frame"
   (select-current-frame :maybe)
-  (when (frame-p *current-child*)
-    (awhen (frame-selected-child *current-child*)
-      (setf *current-child* it)))
+  (when (frame-p (current-child))
+    (awhen (frame-selected-child (current-child))
+      (setf (current-child) it)))
   (show-all-children))
 
 (defun select-previous-level ()
   "Select the previous level in frame"
-  (unless (child-root-p *current-child*)
+  (unless (child-root-p (current-child))
     (select-current-frame :maybe)
-    (awhen (find-parent-frame *current-child*)
-      (setf *current-child* it))
+    (awhen (find-parent-frame (current-child))
+      (setf (current-child) it))
     (show-all-children)))
 
 
 (defun enter-frame ()
   "Enter in the selected frame - ie make it the root frame"
-  (let ((root (find-root *current-child*)))
-    (unless (child-equal-p (root-child root) *current-child*)
-      (change-root root *current-child*))
+  (let ((root (find-root (current-child))))
+    (unless (child-equal-p (root-child root) (current-child))
+      (change-root root (current-child)))
     (show-all-children t)))
 
 (defun leave-frame ()
   "Leave the selected frame - ie make its parent the root frame"
-  (let ((root (find-root *current-child*)))
+  (let ((root (find-root (current-child))))
     (unless (or (child-equal-p (root-child root) *root-frame*)
                 (child-original-root-p (root-child root)))
       (awhen (and root (find-parent-frame (root-child root)))
@@ -1199,8 +1230,8 @@ For window: set current child to window or its parent according to window-parent
 
 (defun frame-lower-child ()
   "Lower the child in the current frame"
-  (when (frame-p *current-child*)
-    (with-slots (child selected-pos) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child selected-pos) (current-child)
       (unless (>= selected-pos (length child))
 	(when (nth (1+ selected-pos) child)
 	  (rotatef (nth selected-pos child)
@@ -1211,8 +1242,8 @@ For window: set current child to window or its parent according to window-parent
 
 (defun frame-raise-child ()
   "Raise the child in the current frame"
-  (when (frame-p *current-child*)
-    (with-slots (child selected-pos) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child selected-pos) (current-child)
       (unless (< selected-pos 1)
 	(when (nth (1- selected-pos) child)
 	  (rotatef (nth selected-pos child)
@@ -1223,8 +1254,8 @@ For window: set current child to window or its parent according to window-parent
 
 (defun frame-select-next-child ()
   "Select the next child in the current frame"
-  (when (frame-p *current-child*)
-    (with-slots (child selected-pos) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child selected-pos) (current-child)
       (unless (>= selected-pos (length child))
 	(incf selected-pos)))
     (show-all-children)))
@@ -1232,8 +1263,8 @@ For window: set current child to window or its parent according to window-parent
 
 (defun frame-select-previous-child ()
   "Select the previous child in the current frame"
-  (when (frame-p *current-child*)
-    (with-slots (child selected-pos) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child selected-pos) (current-child)
       (unless (< selected-pos 1)
 	(decf selected-pos)))
     (show-all-children)))
@@ -1242,16 +1273,16 @@ For window: set current child to window or its parent according to window-parent
 
 (defun switch-to-root-frame (&key (show-later nil))
   "Switch to the root frame"
-  (let ((root (find-root *current-child*)))
+  (let ((root (find-root (current-child))))
     (change-root root (root-original root)))
   (unless show-later
     (show-all-children t)))
 
 (defun switch-and-select-root-frame (&key (show-later nil))
   "Switch and select the root frame"
-  (let ((root (find-root *current-child*)))
+  (let ((root (find-root (current-child))))
     (change-root root (root-original root))
-    (setf *current-child* (root-original root)))
+    (setf (current-child) (root-original root)))
   (unless show-later
     (show-all-children t)))
 
@@ -1270,8 +1301,8 @@ For window: set current child to window or its parent according to window-parent
       (progn
         (awhen (child-root-p child)
           (change-root it (find-parent-frame child)))
-        (when (child-equal-p child *current-child*)
-          (setf *current-child* (root-child (find-root child))))
+        (when (child-equal-p child (current-child))
+          (setf (current-child) (root-child (find-root child))))
         t)))
 
 
@@ -1340,28 +1371,6 @@ Warning:frame window and gc are freeed."
 
 
 
-
-
-(defun place-window-from-hints (window)
-  "Place a window from its hints"
-  (let* ((hints (xlib:wm-normal-hints window))
-	 (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
-	 (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
-	 (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (x-drawable-width *root*)))
-	 (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (x-drawable-height *root*)))
-	 (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
-		     (x-drawable-width window)))
-	 (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
-		      (x-drawable-height window))))
-    (setf (x-drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
-	  (x-drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
-    (with-placement (*unmanaged-window-placement* x y (x-drawable-width window) (x-drawable-height window))
-      (setf (x-drawable-x window) x
-            (x-drawable-y window) y))
-    (xlib:display-finish-output *display*)))
-
-
-
 (defun do-all-frames-nw-hook (window)
   "Call nw-hook of each frame."
   (catch 'nw-hook-loop
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index b3872a7..e8dafad 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -45,14 +45,14 @@
 ;;; Generic functions
 (defun set-layout (layout)
   "Set the layout of the current child"
-  (when (frame-p *current-child*)
-    (setf (frame-layout *current-child*) layout)
+  (when (frame-p (current-child))
+    (setf (frame-layout (current-child)) layout)
     (leave-second-mode)))
 
 (defun set-layout-dont-leave (layout)
   "Set the layout of the current child"
-  (when (frame-p *current-child*)
-    (setf (frame-layout *current-child*) layout)))
+  (when (frame-p (current-child))
+    (setf (frame-layout (current-child)) layout)))
 
 (defun set-layout-once (layout-name)
   (set-layout-dont-leave layout-name)
@@ -90,14 +90,14 @@
 
 
 (defun layout-ask-size (msg slot &optional (min 80))
-  (when (frame-p *current-child*)
-    (let ((new-size (/ (or (query-number msg (* (frame-data-slot *current-child* slot) 100)) min) 100)))
-      (setf (frame-data-slot *current-child* slot) (max (min new-size 0.99) 0.01)))))
+  (when (frame-p (current-child))
+    (let ((new-size (/ (or (query-number msg (* (frame-data-slot (current-child) slot) 100)) min) 100)))
+      (setf (frame-data-slot (current-child) slot) (max (min new-size 0.99) 0.01)))))
 
 (defun adjust-layout-size (slot inc)
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* slot)
-          (max (min (+ (frame-data-slot *current-child* slot) inc) 0.99) 0.01))))
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) slot)
+          (max (min (+ (frame-data-slot (current-child) slot) inc) 0.99) 0.01))))
 
 (defun inc-tile-layout-size ()
   "Increase the tile layout size"
@@ -124,9 +124,9 @@
 
 (defun fast-layout-switch ()
   "Switch between two layouts"
-  (when (frame-p *current-child*)
-    (with-slots (layout) *current-child*
-      (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
+  (when (frame-p (current-child))
+    (with-slots (layout) (current-child)
+      (let* ((layout-list (frame-data-slot (current-child) :fast-layout))
 	     (first-layout (ensure-function (first layout-list)))
 	     (second-layout (ensure-function (second layout-list))))
 	(setf layout (if (eql layout first-layout)
@@ -137,10 +137,10 @@
 
 (defun push-in-fast-layout-list ()
   "Push the current layout in the fast layout list"
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* :fast-layout)
-	  (list (frame-layout *current-child*)
-		(first (frame-data-slot *current-child* :fast-layout))))
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) :fast-layout)
+	  (list (frame-layout (current-child))
+		(first (frame-data-slot (current-child) :fast-layout))))
     (leave-second-mode)))
 
 
@@ -208,25 +208,25 @@
 
 ;;; Tile layout
 (defun tile-layout-ask-keep-position ()
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (if (query-yes-or-no "Keep frame children positions?")
-	(setf (frame-data-slot *current-child* :tile-layout-keep-position) :yes)
-	(remove-frame-data-slot *current-child* :tile-layout-keep-position))))
+	(setf (frame-data-slot (current-child) :tile-layout-keep-position) :yes)
+	(remove-frame-data-slot (current-child) :tile-layout-keep-position))))
 
 
 
 (labels ((set-managed ()
-           (setf (frame-data-slot *current-child* :layout-managed-children)
-                 (copy-list (get-managed-child *current-child*)))))
+           (setf (frame-data-slot (current-child) :layout-managed-children)
+                 (copy-list (get-managed-child (current-child))))))
   (defun set-layout-managed-children ()
-    (when (frame-p *current-child*)
+    (when (frame-p (current-child))
       (set-managed)
       (tile-layout-ask-keep-position)))
 
 
   (defun update-layout-managed-children-position ()
     "Update layout managed children position"
-    (when (frame-p *current-child*)
+    (when (frame-p (current-child))
       (set-managed)
       (leave-second-mode))))
 
@@ -573,9 +573,9 @@
 
 ;;; Left and space layout: like left layout but leave a space on the left
 (defun layout-ask-space (msg slot &optional (default 100))
-  (when (frame-p *current-child*)
-    (let ((new-space (or (query-number msg (or (frame-data-slot *current-child* slot) default)) default)))
-      (setf (frame-data-slot *current-child* slot) new-space))))
+  (when (frame-p (current-child))
+    (let ((new-space (or (query-number msg (or (frame-data-slot (current-child) slot) default)) default)))
+      (setf (frame-data-slot (current-child) slot) new-space))))
 
 
 (defun tile-left-space-layout (child parent)
@@ -734,26 +734,26 @@
 
 (defun add-in-main-window-list ()
   "Add the current window in the main window list"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (with-current-window
-      (when (child-member window (get-managed-child *current-child*))
-	(pushnew window (frame-data-slot *current-child* :main-window-list)))))
+      (when (child-member window (get-managed-child (current-child)))
+	(pushnew window (frame-data-slot (current-child) :main-window-list)))))
   (leave-second-mode))
 
 
 (defun remove-in-main-window-list ()
   "Remove the current window from the main window list"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (with-current-window
-      (when (child-member window (get-managed-child *current-child*))
-	(setf (frame-data-slot *current-child* :main-window-list)
-	      (child-remove window (frame-data-slot *current-child* :main-window-list))))))
+      (when (child-member window (get-managed-child (current-child)))
+	(setf (frame-data-slot (current-child) :main-window-list)
+	      (child-remove window (frame-data-slot (current-child) :main-window-list))))))
   (leave-second-mode))
 
 (defun clear-main-window-list ()
   "Clear the main window list"
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* :main-window-list) nil))
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) :main-window-list) nil))
   (leave-second-mode))
 
 
@@ -778,15 +778,15 @@
 
 (defun select-next/previous-child-no-main-window (fun-rotate)
   "Select the next/previous child - Skip windows in main window list"
-  (when (frame-p *current-child*)
-    (with-slots (child) *current-child*
-      (let* ((main-windows (frame-data-slot *current-child* :main-window-list))
+  (when (frame-p (current-child))
+    (with-slots (child) (current-child)
+      (let* ((main-windows (frame-data-slot (current-child) :main-window-list))
 	     (to-skip? (not (= (length main-windows)
 			       (length child)))))
 	(labels ((rec ()
 		   (setf child (funcall fun-rotate child))
 		   (when (and to-skip?
-			      (child-member (frame-selected-child *current-child*) main-windows))
+			      (child-member (frame-selected-child (current-child)) main-windows))
 		     (rec))))
 	  (unselect-all-frames)
 	  (rec)
@@ -806,8 +806,8 @@
   "Move and focus the current frame or focus the current window parent.
 Or do actions on corners - Skip windows in main window list"
   (unless (do-corner-action root-x root-y *corner-main-mode-left-button*)
-    (if (and (frame-p *current-child*)
-	     (child-member window (frame-data-slot *current-child* :main-window-list)))
+    (if (and (frame-p (current-child))
+	     (child-member window (frame-data-slot (current-child) :main-window-list)))
 	(replay-button-event)
 	(mouse-click-to-focus-generic root-x root-y #'move-frame))))
 
@@ -832,7 +832,7 @@ Or do actions on corners - Skip windows in main window list"
 
   (defun set-gimp-layout ()
     "The GIMP Layout"
-    (when (frame-p *current-child*)
+    (when (frame-p (current-child))
       ;; Note: There is no need to ungrab/grab keys because this
       ;; is done when leaving the second mode.
       (define-main-key ("F8" :mod-1) 'add-in-main-window-list)
@@ -841,11 +841,11 @@ Or do actions on corners - Skip windows in main window list"
       (define-main-key ("Tab" :mod-1) 'select-next-child-no-main-window)
       (define-main-key ("Tab" :mod-1 :shift) 'select-previous-child-no-main-window)
       (define-main-mouse (1) 'mouse-click-to-focus-and-move-no-main-window)
-      (setf (frame-data-slot *current-child* :focus-policy-save)
-            (frame-focus-policy *current-child*))
-      (setf (frame-focus-policy *current-child*) :sloppy)
-      (setf (frame-data-slot *current-child* :layout-save)
-            (frame-layout *current-child*))
+      (setf (frame-data-slot (current-child) :focus-policy-save)
+            (frame-focus-policy (current-child)))
+      (setf (frame-focus-policy (current-child)) :sloppy)
+      (setf (frame-data-slot (current-child) :layout-save)
+            (frame-layout (current-child)))
       (open-notify-window help-text-list)
       (add-timer *gimp-layout-notify-window-delay* #'close-notify-window)
       ;; Set the default layout and leave the second mode.
@@ -860,10 +860,10 @@ Or do actions on corners - Skip windows in main window list"
   (define-main-key ("Tab" :mod-1) 'select-next-child)
   (define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
   (define-main-mouse (1) 'mouse-click-to-focus-and-move)
-  (setf (frame-focus-policy *current-child*)
-	(frame-data-slot *current-child* :focus-policy-save))
-  (setf (frame-layout *current-child*)
-	(frame-data-slot *current-child* :layout-save))
+  (setf (frame-focus-policy (current-child))
+	(frame-data-slot (current-child) :focus-policy-save))
+  (setf (frame-layout (current-child))
+	(frame-data-slot (current-child) :layout-save))
   (leave-second-mode))
 
 
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index a307824..5dfc885 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -43,9 +43,9 @@
 
 (defun set-nw-hook (hook)
   "Set the hook of the current child"
-  (let ((frame (if (xlib:window-p *current-child*)
-		   (find-parent-frame *current-child*)
-		   *current-child*)))
+  (let ((frame (if (xlib:window-p (current-child))
+		   (find-parent-frame (current-child))
+		   (current-child))))
     (unless (or (child-member frame *permanent-nw-hook-frames*)
                 (child-original-root-p frame))
       (setf (frame-nw-hook frame) hook)
@@ -89,10 +89,10 @@
 (defun default-frame-nw-hook (frame window)
   "Open the next window in the current frame"
   (declare (ignore frame))
-  (leave-if-not-frame *current-child*)
-  (when (frame-p *current-child*)
-    (pushnew window (frame-child *current-child*)))
-  (default-window-placement *current-child* window)
+  (leave-if-not-frame (current-child))
+  (when (frame-p (current-child))
+    (pushnew window (frame-child (current-child))))
+  (default-window-placement (current-child) window)
   t)
 
 (defun set-default-frame-nw-hook ()
@@ -109,7 +109,7 @@
   (leave-if-not-frame (find-current-root))
   (let ((root (find-current-root)))
     (pushnew window (frame-child root))
-    (setf *current-child* (frame-selected-child root))
+    (setf (current-child) (frame-selected-child root))
     (default-window-placement root window))
   t)
 
@@ -129,7 +129,7 @@
         (root (find-current-root)))
     (pushnew new-frame (frame-child root))
     (pushnew window (frame-child new-frame))
-    (setf *current-child* new-frame)
+    (setf (current-child) new-frame)
     (default-window-placement new-frame window))
   t)
 
@@ -149,9 +149,9 @@
     (pushnew new-frame (frame-child root))
     (pushnew window (frame-child new-frame))
     (switch-to-root-frame :show-later t)
-    (setf *current-child* root)
+    (setf (current-child) root)
     (set-layout-once #'tile-space-layout)
-    (setf *current-child* new-frame)
+    (setf (current-child) new-frame)
     (default-window-placement new-frame window))
   t)
 
@@ -172,9 +172,9 @@
       (pushnew new-frame (frame-child parent))
       (pushnew window (frame-child new-frame))
       (change-root (find-root parent) parent)
-      (setf *current-child* parent)
+      (setf (current-child) parent)
       (set-layout-once #'tile-space-layout)
-      (setf *current-child* new-frame)
+      (setf (current-child) new-frame)
       (default-window-placement new-frame window)
       (show-all-children t)
       t)))
@@ -192,12 +192,12 @@
 (defun leave-focus-frame-nw-hook (frame window)
   "Open the next window in the current frame and leave the focus on the current child"
   (clear-nw-hook frame)
-  (leave-if-not-frame *current-child*)
-  (when (frame-p *current-child*)
-    (with-slots (child) *current-child*
+  (leave-if-not-frame (current-child))
+  (when (frame-p (current-child))
+    (with-slots (child) (current-child)
       (pushnew window child)
       (setf child (rotate-list child))))
-  (default-window-placement *current-child* window)
+  (default-window-placement (current-child) window)
   t)
 
 (defun set-leave-focus-frame-nw-hook ()
@@ -215,7 +215,7 @@
     (pushnew window (frame-child frame))
     (unless (find-child-in-all-root frame)
       (change-root (find-root frame) frame))
-    (setf *current-child* frame)
+    (setf (current-child) frame)
     (focus-all-children window frame)
     (default-window-placement frame window)
     (show-all-children t)
@@ -261,7 +261,7 @@
       (unless *in-process-existing-windows*
 	(unless (find-child-in-all-root frame)
           (change-root (find-root frame) frame))
-	(setf *current-child* frame)
+	(setf (current-child) frame)
 	(focus-all-children window frame)
 	(default-window-placement frame window)
 	(show-all-children t))
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index cf525ef..7a075a9 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -207,7 +207,7 @@
 
 (defun explode-current-frame ()
   "Create a new frame for each window in frame"
-  (explode-frame *current-child*)
+  (explode-frame (current-child))
   (leave-second-mode))
 
 
@@ -223,7 +223,7 @@
 
 (defun implode-current-frame ()
   "Absorb all frames subchildren in frame (explode frame opposite)"
-  (implode-frame *current-child*)
+  (implode-frame (current-child))
   (leave-second-mode))
 
 
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 4c4ccb0..8aa4c0b 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -106,15 +106,15 @@
 ;;; Current child placement
 ;;;
 (defun current-child-coord ()
-  (typecase *current-child*
-    (xlib:window (values (x-drawable-x *current-child*)
-			 (x-drawable-y *current-child*)
-			 (x-drawable-width *current-child*)
-			 (x-drawable-height *current-child*)))
-    (frame (values (frame-rx *current-child*)
-		   (frame-ry *current-child*)
-		   (frame-rw *current-child*)
-		   (frame-rh *current-child*)))
+  (typecase (current-child)
+    (xlib:window (values (x-drawable-x (current-child))
+			 (x-drawable-y (current-child))
+			 (x-drawable-width (current-child))
+			 (x-drawable-height (current-child))))
+    (frame (values (frame-rx (current-child))
+		   (frame-ry (current-child))
+		   (frame-rw (current-child))
+		   (frame-rh (current-child))))
     (t (values 0 0 10 10))))
 
 (defmacro with-current-child-coord ((x y w h) &body body)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 34cebcc..8bc4c62 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -72,11 +72,36 @@
 
 
 
+(defun banish-pointer ()
+  "Move the pointer to the lower right corner of the screen"
+  (with-placement (*banish-pointer-placement* x y)
+    (xlib:warp-pointer *root* x y)))
+
+
+(defun place-window-from-hints (window)
+  "Place a window from its hints"
+  (let* ((hints (xlib:wm-normal-hints window))
+	 (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
+	 (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
+	 (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (x-drawable-width *root*)))
+	 (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (x-drawable-height *root*)))
+	 (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
+		     (x-drawable-width window)))
+	 (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
+		      (x-drawable-height window))))
+    (setf (x-drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
+	  (x-drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
+    (with-placement (*unmanaged-window-placement* x y (x-drawable-width window) (x-drawable-height window))
+      (setf (x-drawable-x window) x
+            (x-drawable-y window) y))
+    (xlib:display-finish-output *display*)))
+
+
 (defun rename-current-child ()
   "Rename the current child"
-  (let ((name (query-string (format nil "New child name: (last: ~A)" (child-name *current-child*))
-			    (child-name *current-child*))))
-    (rename-child *current-child* name)
+  (let ((name (query-string (format nil "New child name: (last: ~A)" (child-name (current-child)))
+			    (child-name (current-child)))))
+    (rename-child (current-child) name)
     (leave-second-mode)))
 
 
@@ -90,16 +115,16 @@
 
 (defun set-current-child-transparency ()
   "Set the current child transparency"
-  (ask-child-transparency "child" *current-child*)
+  (ask-child-transparency "child" (current-child))
   (leave-second-mode))
 
 
 (defun renumber-current-frame ()
   "Renumber the current frame"
-  (when (frame-p *current-child*)
-    (let ((number (query-number (format nil "New child number: (last: ~A)" (frame-number *current-child*))
-				(frame-number *current-child*))))
-      (setf (frame-number *current-child*) number)
+  (when (frame-p (current-child))
+    (let ((number (query-number (format nil "New child number: (last: ~A)" (frame-number (current-child)))
+				(frame-number (current-child)))))
+      (setf (frame-number (current-child)) number)
       (leave-second-mode))))
 
 
@@ -107,22 +132,22 @@
 
 (defun add-default-frame ()
   "Add a default frame in the current frame"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (let ((name (query-string "Frame name")))
-      (push (create-frame :name name) (frame-child *current-child*))))
+      (push (create-frame :name name) (frame-child (current-child)))))
   (leave-second-mode))
 
 (defun add-frame-in-parent-frame ()
   "Add a frame in the parent frame (and reorganize parent frame)"
-  (let ((parent (find-parent-frame *current-child*)))
-    (when (and parent (not (child-original-root-p *current-child*)))
+  (let ((parent (find-parent-frame (current-child))))
+    (when (and parent (not (child-original-root-p (current-child))))
       (let ((new-frame (create-frame)))
         (pushnew new-frame (frame-child parent))
-        (awhen (child-root-p *current-child*)
+        (awhen (child-root-p (current-child))
           (change-root it parent))
-        (setf *current-child* parent)
+        (setf (current-child) parent)
         (set-layout-once #'tile-space-layout)
-        (setf *current-child* new-frame)
+        (setf (current-child) new-frame)
         (leave-second-mode)))))
 
 
@@ -130,22 +155,22 @@
 
 (defun add-placed-frame ()
   "Add a placed frame in the current frame"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (let ((name (query-string "Frame name"))
 	  (x (/ (query-number "Frame x in percent (%)") 100))
 	  (y (/ (query-number "Frame y in percent (%)") 100))
 	  (w (/ (query-number "Frame width in percent (%)" 100) 100))
 	  (h (/ (query-number "Frame height in percent (%)" 100) 100)))
       (push (create-frame :name name :x x :y y :w w :h h)
-	    (frame-child *current-child*))))
+	    (frame-child (current-child)))))
   (leave-second-mode))
 
 
 
 (defun delete-focus-window-generic (close-fun)
   (with-focus-window (window)
-    (when (child-equal-p window *current-child*)
-      (setf *current-child* (find-current-root)))
+    (when (child-equal-p window (current-child))
+      (setf (current-child) (find-current-root)))
     (delete-child-and-children-in-all-frames window close-fun)))
 
 (defun delete-focus-window ()
@@ -159,7 +184,7 @@
 (defun remove-focus-window ()
   "Remove the focus window from the current frame"
   (with-focus-window (window)
-    (setf *current-child* (find-current-root))
+    (setf (current-child) (find-current-root))
     (hide-child window)
     (remove-child-in-frame window (find-parent-frame window))
     (show-all-children)))
@@ -180,7 +205,7 @@
   "Return the child window under the mouse"
   (let ((win *root*))
     (with-all-windows-frames-and-parent (*root-frame* child parent)
-      (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+      (when (and (or (managed-window-p child parent) (child-equal-p parent (current-child)))
                  (not (window-hidden-p child))
 		 (in-window child x y))
 	(setf win child))
@@ -208,7 +233,7 @@
   (let ((ret nil))
     (with-all-windows-frames-and-parent (*root-frame* child parent)
       (when (and (not (window-hidden-p child))
-		 (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+		 (or (managed-window-p child parent) (child-equal-p parent (current-child)))
 		 (in-window child x y))
 	(if first-foundp
 	    (return-from find-child-under-mouse-in-child-tree child)
@@ -238,54 +263,54 @@
 
 (defun copy-current-child ()
   "Copy the current child to the selection"
-  (pushnew *current-child* *child-selection*)
+  (pushnew (current-child) *child-selection*)
   (display-all-root-frame-info))
 
 
 (defun cut-current-child (&optional (show-now t))
   "Cut the current child to the selection"
-  (unless (child-root-p *current-child*)
-    (let ((parent (find-parent-frame *current-child*)))
-      (hide-all *current-child*)
+  (unless (child-root-p (current-child))
+    (let ((parent (find-parent-frame (current-child))))
+      (hide-all (current-child))
       (copy-current-child)
-      (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
+      (remove-child-in-frame (current-child) (find-parent-frame (current-child) (find-current-root)))
       (when parent
-        (setf *current-child* parent))
+        (setf (current-child) parent))
       (when show-now
         (show-all-children t))
-      *current-child*)))
+      (current-child))))
 
 (defun remove-current-child ()
   "Remove the current child from its parent frame"
-  (unless (child-root-p *current-child*)
-    (let ((parent (find-parent-frame *current-child*)))
-      (hide-all *current-child*)
-      (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
+  (unless (child-root-p (current-child))
+    (let ((parent (find-parent-frame (current-child))))
+      (hide-all (current-child))
+      (remove-child-in-frame (current-child) (find-parent-frame (current-child) (find-current-root)))
       (when parent
-        (setf *current-child* parent))
+        (setf (current-child) parent))
       (show-all-children t)
       (leave-second-mode))))
 
 (defun delete-current-child ()
   "Delete the current child and its children in all frames"
-  (unless (child-root-p *current-child*)
-    (hide-all *current-child*)
-    (delete-child-and-children-in-all-frames *current-child*)
+  (unless (child-root-p (current-child))
+    (hide-all (current-child))
+    (delete-child-and-children-in-all-frames (current-child))
     (show-all-children t)
     (leave-second-mode)))
 
 
 (defun paste-selection-no-clear ()
   "Paste the selection in the current frame - Do not clear the selection after paste"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (dolist (child *child-selection*)
-      (unless (find-child-in-parent child *current-child*)
-        (pushnew child (frame-child *current-child*) :test #'child-equal-p)))
+      (unless (find-child-in-parent child (current-child))
+        (pushnew child (frame-child (current-child)) :test #'child-equal-p)))
     (show-all-children)))
 
 (defun paste-selection ()
   "Paste the selection in the current frame"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (paste-selection-no-clear)
     (setf *child-selection* nil)
     (display-all-root-frame-info)))
@@ -294,14 +319,14 @@
 (defun copy-focus-window ()
   "Copy the focus window to the selection"
   (with-focus-window (window)
-    (let ((*current-child* window))
+    (with-current-child (window)
       (copy-current-child))))
 
 
 (defun cut-focus-window ()
   "Cut the focus window to the selection"
   (with-focus-window (window)
-    (setf *current-child* (let ((*current-child* window))
+    (setf (current-child) (with-current-child (window)
                             (cut-current-child nil)))
     (show-all-children t)))
 
@@ -313,15 +338,15 @@
 ;;; Maximize function
 (defun frame-toggle-maximize ()
   "Maximize/Unmaximize the current frame in its parent frame"
-  (when (frame-p *current-child*)
-    (let ((unmaximized-coords (frame-data-slot *current-child* :unmaximized-coords)))
+  (when (frame-p (current-child))
+    (let ((unmaximized-coords (frame-data-slot (current-child) :unmaximized-coords)))
       (if unmaximized-coords
-	  (with-slots (x y w h) *current-child*
+	  (with-slots (x y w h) (current-child)
 	    (destructuring-bind (nx ny nw nh) unmaximized-coords
-	      (setf (frame-data-slot *current-child* :unmaximized-coords) nil
+	      (setf (frame-data-slot (current-child) :unmaximized-coords) nil
 		    x nx y ny w nw h nh)))
-	  (with-slots (x y w h) *current-child*
-	    (setf (frame-data-slot *current-child* :unmaximized-coords)
+	  (with-slots (x y w h) (current-child)
+	    (setf (frame-data-slot (current-child) :unmaximized-coords)
 		  (list x y w h)
 		  x 0 y 0 w 1 h 1))))
     (show-all-children)
@@ -493,8 +518,8 @@
 (defun delete-frame-by (frame)
   (unless (or (child-equal-p frame *root-frame*)
               (child-root-p frame))
-    (when (child-equal-p frame *current-child*)
-      (setf *current-child* (find-current-root)))
+    (when (child-equal-p frame (current-child))
+      (setf (current-child) (find-current-root)))
     (remove-child-in-frame frame (find-parent-frame frame)))
   (show-all-children t))
 
@@ -520,16 +545,16 @@
 
 (defun move-current-child-by-name ()
   "Move current child in a named frame"
-  (move-child-to *current-child*
+  (move-child-to (current-child)
 		 (find-frame-by-name
-		  (ask-frame-name (format nil "Move '~A' to frame: " (child-name *current-child*)))))
+		  (ask-frame-name (format nil "Move '~A' to frame: " (child-name (current-child))))))
   (leave-second-mode))
 
 (defun move-current-child-by-number ()
   "Move current child in a numbered frame"
-  (move-child-to *current-child*
+  (move-child-to (current-child)
 		 (find-frame-by-number
-		  (query-number (format nil "Move '~A' to frame numbered:" (child-name *current-child*)))))
+		  (query-number (format nil "Move '~A' to frame numbered:" (child-name (current-child))))))
   (leave-second-mode))
 
 
@@ -542,16 +567,16 @@
 
 (defun copy-current-child-by-name ()
   "Copy current child in a named frame"
-  (copy-child-to *current-child*
+  (copy-child-to (current-child)
 		 (find-frame-by-name
-		  (ask-frame-name (format nil "Copy '~A' to frame: " (child-name *current-child*)))))
+		  (ask-frame-name (format nil "Copy '~A' to frame: " (child-name (current-child))))))
   (leave-second-mode))
 
 (defun copy-current-child-by-number ()
   "Copy current child in a numbered frame"
-  (copy-child-to *current-child*
+  (copy-child-to (current-child)
 		 (find-frame-by-number
-		  (query-number (format nil "Copy '~A' to frame numbered:" (child-name *current-child*)))))
+		  (query-number (format nil "Copy '~A' to frame numbered:" (child-name (current-child))))))
   (leave-second-mode))
 
 
@@ -610,7 +635,7 @@ mouse-fun is #'move-frame or #'resize-frame"
                  (setf parent child
                        child (create-frame)
                        mouse-fn #'resize-frame
-                       *current-child* child)
+                       (current-child) child)
                  (place-frame child parent root-x root-y 10 10)
                  (map-window (frame-window child))
                  (pushnew child (frame-child parent)))))
@@ -758,7 +783,7 @@ For window: set current child to window or its parent according to window-parent
       (current-slot 1))
   (defun bind-on-slot (&optional (slot current-slot))
     "Bind current child to slot"
-    (setf (aref key-slots slot) *current-child*))
+    (setf (aref key-slots slot) (current-child)))
 
   (defun remove-binding-on-slot ()
     "Remove binding on slot"
@@ -770,19 +795,19 @@ For window: set current child to window or its parent according to window-parent
       (when (find-child jump-child *root-frame*)
         (unless (find-child-in-all-root jump-child)
           (change-root (find-root jump-child) jump-child))
-	(setf *current-child* jump-child)
-	(focus-all-children *current-child* *current-child*)
+	(setf (current-child) jump-child)
+	(focus-all-children (current-child) (current-child))
 	(show-all-children t))))
 
   (defun bind-or-jump (n)
     "Bind or jump to a slot (a frame or a window)"
     (setf current-slot (- n 1))
     (let ((default-bind `("b" bind-on-slot
-			      ,(format nil "Bind slot ~A on child: ~A" n (child-fullname *current-child*)))))
+			      ,(format nil "Bind slot ~A on child: ~A" n (child-fullname (current-child))))))
       (info-mode-menu (aif (aref key-slots current-slot)
 			   `(,default-bind
 				("BackSpace" remove-binding-on-slot
-					     ,(format nil "Remove slot ~A binding on child: ~A" n (child-fullname *current-child*)))
+					     ,(format nil "Remove slot ~A binding on child: ~A" n (child-fullname (current-child))))
 				("   -  " nil " -")
 			      ("Tab" jump-to-slot
 				     ,(format nil "Jump to child: ~A" (aif (aref key-slots current-slot)
@@ -798,7 +823,7 @@ For window: set current child to window or its parent according to window-parent
 ;;; Useful function for the second mode ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defmacro with-movement (&body body)
-  `(when (frame-p *current-child*)
+  `(when (frame-p (current-child))
      , at body
      (show-all-children)
      (display-all-frame-info)
@@ -809,90 +834,90 @@ For window: set current child to window or its parent according to window-parent
 ;;; Pack
 (defun current-frame-pack-up ()
   "Pack the current frame up"
-  (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (pack-frame-up (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-pack-down ()
   "Pack the current frame down"
-  (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (pack-frame-down (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-pack-left ()
   "Pack the current frame left"
-  (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (pack-frame-left (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-pack-right ()
   "Pack the current frame right"
-  (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (pack-frame-right (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 ;;; Center
 (defun center-current-frame ()
   "Center the current frame"
-  (with-movement (center-frame *current-child*)))
+  (with-movement (center-frame (current-child))))
 
 ;;; Fill
 (defun current-frame-fill-up ()
   "Fill the current frame up"
-  (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (fill-frame-up (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-fill-down ()
   "Fill the current frame down"
-  (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (fill-frame-down (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-fill-left ()
   "Fill the current frame left"
-  (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (fill-frame-left (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-fill-right ()
   "Fill the current frame right"
-  (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
+  (with-movement (fill-frame-right (current-child) (find-parent-frame (current-child) (find-current-root)))))
 
 (defun current-frame-fill-all-dir ()
   "Fill the current frame in all directions"
   (with-movement
-    (let ((parent (find-parent-frame *current-child* (find-current-root))))
-      (fill-frame-up *current-child* parent)
-      (fill-frame-down *current-child* parent)
-      (fill-frame-left *current-child* parent)
-      (fill-frame-right *current-child* parent))))
+    (let ((parent (find-parent-frame (current-child) (find-current-root))))
+      (fill-frame-up (current-child) parent)
+      (fill-frame-down (current-child) parent)
+      (fill-frame-left (current-child) parent)
+      (fill-frame-right (current-child) parent))))
 
 (defun current-frame-fill-vertical ()
   "Fill the current frame vertically"
   (with-movement
-    (let ((parent (find-parent-frame *current-child* (find-current-root))))
-      (fill-frame-up *current-child* parent)
-      (fill-frame-down *current-child* parent))))
+    (let ((parent (find-parent-frame (current-child) (find-current-root))))
+      (fill-frame-up (current-child) parent)
+      (fill-frame-down (current-child) parent))))
 
 (defun current-frame-fill-horizontal ()
   "Fill the current frame horizontally"
   (with-movement
-    (let ((parent (find-parent-frame *current-child* (find-current-root))))
-      (fill-frame-left *current-child* parent)
-      (fill-frame-right *current-child* parent))))
+    (let ((parent (find-parent-frame (current-child) (find-current-root))))
+      (fill-frame-left (current-child) parent)
+      (fill-frame-right (current-child) parent))))
 
 
 ;;; Resize
 (defun current-frame-resize-up ()
   "Resize the current frame up to its half height"
-  (with-movement (resize-half-height-up *current-child*)))
+  (with-movement (resize-half-height-up (current-child))))
 
 (defun current-frame-resize-down ()
   "Resize the current frame down to its half height"
-  (with-movement (resize-half-height-down *current-child*)))
+  (with-movement (resize-half-height-down (current-child))))
 
 (defun current-frame-resize-left ()
   "Resize the current frame left to its half width"
-  (with-movement (resize-half-width-left *current-child*)))
+  (with-movement (resize-half-width-left (current-child))))
 
 (defun current-frame-resize-right ()
   "Resize the current frame right to its half width"
-  (with-movement (resize-half-width-right *current-child*)))
+  (with-movement (resize-half-width-right (current-child))))
 
 (defun current-frame-resize-all-dir ()
   "Resize down the current frame"
-  (with-movement (resize-frame-down *current-child*)))
+  (with-movement (resize-frame-down (current-child))))
 
 (defun current-frame-resize-all-dir-minimal ()
   "Resize down the current frame to its minimal size"
-  (with-movement (resize-minimal-frame *current-child*)))
+  (with-movement (resize-minimal-frame (current-child))))
 
 
 ;;; Children navigation
@@ -921,17 +946,17 @@ For window: set current child to window or its parent according to window-parent
 ;;; Adapt frame functions
 (defun adapt-current-frame-to-window-hints-generic (width-p height-p)
   "Adapt the current frame to the current window minimal size hints"
-  (when (frame-p *current-child*)
-    (let ((window (first (frame-child *current-child*))))
+  (when (frame-p (current-child))
+    (let ((window (first (frame-child (current-child)))))
       (when (xlib:window-p window)
 	(let* ((hints (xlib:wm-normal-hints window))
 	       (min-width (and hints (xlib:wm-size-hints-min-width hints)))
 	       (min-height (and hints (xlib:wm-size-hints-min-height hints))))
 	  (when (and width-p min-width)
-	    (setf (frame-rw *current-child*) min-width))
+	    (setf (frame-rw (current-child)) min-width))
 	  (when (and height-p min-height)
-	    (setf (frame-rh *current-child*) min-height))
-	  (fixe-real-size *current-child* (find-parent-frame *current-child*))
+	    (setf (frame-rh (current-child)) min-height))
+	  (fixe-real-size (current-child) (find-parent-frame (current-child)))
 	  (leave-second-mode))))))
 
 (defun adapt-current-frame-to-window-hints ()
@@ -951,18 +976,18 @@ For window: set current child to window or its parent according to window-parent
 
 ;;; Managed window type functions
 (defun current-frame-manage-window-type-generic (type-list)
-  (when (frame-p *current-child*)
-    (setf (frame-managed-type *current-child*) type-list
-	  (frame-forced-managed-window *current-child*) nil
-	  (frame-forced-unmanaged-window *current-child*) nil))
+  (when (frame-p (current-child))
+    (setf (frame-managed-type (current-child)) type-list
+	  (frame-forced-managed-window (current-child)) nil
+	  (frame-forced-unmanaged-window (current-child)) nil))
   (leave-second-mode))
 
 
 (defun current-frame-manage-window-type ()
   "Change window types to be managed by a frame"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (let* ((type-str (query-string "Managed window type: (all, normal, transient, maxsize, desktop, dock, toolbar, menu, utility, splash, dialog)"
-				   (format nil "~{~:(~A~) ~}" (frame-managed-type *current-child*))))
+				   (format nil "~{~:(~A~) ~}" (frame-managed-type (current-child)))))
 	   (type-list (loop :for type :in (split-string type-str)
 			 :collect (intern (string-upcase type) :keyword))))
       (current-frame-manage-window-type-generic type-list))))
@@ -1081,32 +1106,32 @@ For window: set current child to window or its parent according to window-parent
 (defun hide/show-frame-window (frame value)
   "Hide/show the frame window"
   (when (frame-p frame)
-    (setf (frame-show-window-p *current-child*) value)
+    (setf (frame-show-window-p (current-child)) value)
     (show-all-children))
   (leave-second-mode))
 
 
 (defun hide-current-frame-window ()
   "Hide the current frame window"
-  (hide/show-frame-window *current-child* nil))
+  (hide/show-frame-window (current-child) nil))
 
 (defun show-current-frame-window ()
   "Show the current frame window"
-  (hide/show-frame-window *current-child* t))
+  (hide/show-frame-window (current-child) t))
 
 
 
 ;;; Hide/Unhide current child
 (defun hide-current-child ()
   "Hide the current child"
-  (unless (child-root-p *current-child*)
-    (let ((parent (find-parent-frame *current-child*)))
+  (unless (child-root-p (current-child))
+    (let ((parent (find-parent-frame (current-child))))
       (when (frame-p parent)
 	(with-slots (child hidden-children) parent
-	  (hide-all *current-child*)
-	  (setf child (child-remove *current-child* child))
-	  (pushnew *current-child* hidden-children)
-	  (setf *current-child* parent))
+	  (hide-all (current-child))
+	  (setf child (child-remove (current-child) child))
+	  (pushnew (current-child) hidden-children)
+	  (setf (current-child) parent))
 	(show-all-children)))
     (leave-second-mode)))
 
@@ -1122,14 +1147,14 @@ For window: set current child to window or its parent according to window-parent
 
 (defun unhide-a-child ()
   "Unhide a child in the current frame"
-  (when (frame-p *current-child*)
-    (with-slots (child hidden-children) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child hidden-children) (current-child)
       (info-mode-menu (loop :for i :from 0
 			 :for hidden :in hidden-children
 			 :collect (list (code-char (+ (char-code #\a) i))
 					(let ((lhd hidden))
 					  (lambda ()
-					    (frame-unhide-child lhd *current-child* *current-child*)))
+					    (frame-unhide-child lhd (current-child) (current-child))))
 					(format nil "Unhide ~A" (child-fullname hidden))))))
     (show-all-children))
   (leave-second-mode))
@@ -1137,8 +1162,8 @@ For window: set current child to window or its parent according to window-parent
 
 (defun unhide-all-children ()
   "Unhide all current frame hidden children"
-  (when (frame-p *current-child*)
-    (with-slots (child hidden-children) *current-child*
+  (when (frame-p (current-child))
+    (with-slots (child hidden-children) (current-child)
       (dolist (c hidden-children)
 	(pushnew c child))
       (setf hidden-children nil))
@@ -1148,7 +1173,7 @@ For window: set current child to window or its parent according to window-parent
 
 (defun unhide-a-child-from-all-frames ()
   "Unhide a child from all frames in the current frame"
-  (when (frame-p *current-child*)
+  (when (frame-p (current-child))
     (let ((acc nil)
 	  (keynum -1))
       (with-all-frames (*root-frame* frame)
@@ -1158,7 +1183,7 @@ For window: set current child to window or its parent according to window-parent
 	    (push (list (code-char (+ (char-code #\a) (incf keynum)))
 			(let ((lhd hidden))
 			  (lambda ()
-			    (frame-unhide-child lhd frame *current-child*)))
+			    (frame-unhide-child lhd frame (current-child))))
 			(format nil "Unhide ~A" (child-fullname hidden)))
 		  acc))))
       (info-mode-menu (nreverse acc)))
@@ -1174,11 +1199,11 @@ For window: set current child to window or its parent according to window-parent
     (setf last-child nil))
   (defun switch-to-last-child ()
     "Store the current child and switch to the previous one"
-    (let ((current-child *current-child*))
+    (let ((current-child (current-child)))
       (when last-child
         (change-root (find-root last-child) last-child)
-        (setf *current-child* last-child)
-	(focus-all-children *current-child* *current-child*)
+        (setf (current-child) last-child)
+	(focus-all-children (current-child) (current-child))
 	(show-all-children t))
       (setf last-child current-child))
     (leave-second-mode)))
@@ -1191,8 +1216,8 @@ For window: set current child to window or its parent according to window-parent
 
 ;;; Focus policy functions
 (defun set-focus-policy-generic (focus-policy)
-  (when (frame-p *current-child*)
-    (setf (frame-focus-policy *current-child*) focus-policy))
+  (when (frame-p (current-child))
+    (setf (frame-focus-policy (current-child)) focus-policy))
   (leave-second-mode))
 
 
@@ -1420,20 +1445,20 @@ For window: set current child to window or its parent according to window-parent
 ;;; Hide or show unmanaged windows utility.
 (defun set-hide-unmanaged-window ()
   "Hide unmanaged windows when frame is not selected"
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* :unmanaged-window-action) :hide)
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) :unmanaged-window-action) :hide)
     (leave-second-mode)))
 
 (defun set-show-unmanaged-window ()
   "Show unmanaged windows when frame is not selected"
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* :unmanaged-window-action) :show)
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) :unmanaged-window-action) :show)
     (leave-second-mode)))
 
 (defun set-default-hide-unmanaged-window ()
   "Set default behaviour to hide or not unmanaged windows when frame is not selected"
-  (when (frame-p *current-child*)
-    (setf (frame-data-slot *current-child* :unmanaged-window-action) nil)
+  (when (frame-p (current-child))
+    (setf (frame-data-slot (current-child) :unmanaged-window-action) nil)
     (leave-second-mode)))
 
 (defun set-globally-hide-unmanaged-window ()
@@ -1584,8 +1609,8 @@ For window: set current child to window or its parent according to window-parent
 					 :font font
 					 :line-style :solid))
           (setf (window-transparency window) *notify-window-transparency*)
-	  (when (frame-p *current-child*)
-	    (setf current-child *current-child*))
+	  (when (frame-p (current-child))
+	    (setf current-child (current-child)))
           (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*)
 	  (map-window window)
 	  (refresh-notify-window)
@@ -1610,7 +1635,7 @@ For window: set current child to window or its parent according to window-parent
 		    (return win)))))
     (if window
         (let ((parent (find-parent-frame window)))
-          (setf *current-child* parent)
+          (setf (current-child) parent)
 	  (put-child-on-top window parent)
           (when maximized
             (change-root (find-root parent) parent))
@@ -1661,22 +1686,22 @@ For window: set current child to window or its parent according to window-parent
 ;;; Geometry change functions
 (defun swap-frame-geometry ()
   "Swap current brother frame geometry"
-  (when (frame-p *current-child*)
-    (let ((parent (find-parent-frame *current-child*)))
+  (when (frame-p (current-child))
+    (let ((parent (find-parent-frame (current-child))))
       (when (frame-p parent)
         (let ((brother (second (frame-child parent))))
           (when (frame-p brother)
-            (rotatef (frame-x *current-child*) (frame-x brother))
-            (rotatef (frame-y *current-child*) (frame-y brother))
-            (rotatef (frame-w *current-child*) (frame-w brother))
-            (rotatef (frame-h *current-child*) (frame-h brother))
+            (rotatef (frame-x (current-child)) (frame-x brother))
+            (rotatef (frame-y (current-child)) (frame-y brother))
+            (rotatef (frame-w (current-child)) (frame-w brother))
+            (rotatef (frame-h (current-child)) (frame-h brother))
             (show-all-children t)
             (leave-second-mode)))))))
 
 (defun rotate-frame-geometry-generic (fun)
   "(Rotate brother frame geometry"
-  (when (frame-p *current-child*)
-    (let ((parent (find-parent-frame *current-child*)))
+  (when (frame-p (current-child))
+    (let ((parent (find-parent-frame (current-child))))
       (when (frame-p parent)
         (let* ((child-list (funcall fun (frame-child parent)))
                (first (first child-list)))
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index acb0a47..2cf7718 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -72,7 +72,7 @@
 	(case stack-mode
 	  (:above
 	   (unless (null-size-window-p window)
-	     (when (or (child-equal-p window *current-child*)
+	     (when (or (child-equal-p window (current-child))
 		       (is-in-current-child-p window))
 	       (raise-window window)
 	       (focus-window window)
@@ -113,12 +113,12 @@
 (define-handler main-mode :enter-notify  (window root-x root-y)
   (unless (and (> root-x (- (xlib:screen-width *screen*) 3))
 	       (> root-y (- (xlib:screen-height *screen*) 3)))
-    (case (if (frame-p *current-child*)
-	      (frame-focus-policy *current-child*)
+    (case (if (frame-p (current-child))
+	      (frame-focus-policy (current-child))
 	      *default-focus-policy*)
       (:sloppy (focus-window window))
-      (:sloppy-strict (when (and (frame-p *current-child*)
-				 (child-member window (frame-child *current-child*)))
+      (:sloppy-strict (when (and (frame-p (current-child))
+				 (child-member window (frame-child (current-child))))
 			(focus-window window)))
       (:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
 			     (parent (find-parent-frame child)))
@@ -126,7 +126,7 @@
 				    (equal (typecase child
 				    	     (xlib:window parent)
 					     (t child))
-					   *current-child*))
+					   (current-child)))
 			    (focus-all-children child parent)
 			    (show-all-children)))))))
 
@@ -176,7 +176,7 @@
                                         :layout nil :x 0.05 :y 0.05
                                         :w 0.9 :h 0.9)
                           *root-frame*)))
-    (setf *current-child* frame)))
+    (setf (current-child) frame)))
 
 
 (defun init-display ()
@@ -200,9 +200,6 @@
   (clear-timers)
   (map-window *no-focus-window*)
   (dbg *display*)
-  (dbg (xlib:display-roots *display*))
-  (dbg (xlib:display-plist *display*))
-  (dbg (xlib:query-extension *display* "XINERAMA"))
   (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
 							      :substructure-notify
 							      :property-change
@@ -216,7 +213,7 @@
   (setf *child-selection* nil)
   (setf *root-frame* (create-frame :name "Root" :number 0)
         *current-root* *root-frame*  ;;; PHIL: TO REMOVE
-	*current-child* *root-frame*)
+	(current-child) *root-frame*)
   (call-hook *init-hook*)
   (unsure-at-least-one-root)
   (process-existing-windows *screen*)
diff --git a/src/package.lisp b/src/package.lisp
index e4934ab..a301749 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -171,8 +171,8 @@ It is particulary useful with CLISP/MIT-CLX.")
   "Root of the root - ie the root frame")
 (defparameter *current-root* nil    ;;; PHIL: TO REMOVE
   "The current fullscreen maximized child")
-(defparameter *current-child* nil
-  "The current child with the focus")
+;;(defparameter (current-child) nil  ;;; PHIL: TO REMOVE
+;;  "The current child with the focus")
 
 
 (defparameter *main-keys* nil)
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index c40a0d6..7e42730 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -215,12 +215,6 @@ they should be windows. So use this function to make a window out of them."
     (values host num)))
 
 
-(defun banish-pointer ()
-  "Move the pointer to the lower right corner of the screen"
-  (with-placement (*banish-pointer-placement* x y)
-    (xlib:warp-pointer *root* x y)))
-
-
 ;;; Transparency support
 (let ((opaque #xFFFFFFFF))
   (defun window-transparency (window)

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

Summary of changes:
 ChangeLog                      |    5 +
 clfswm.asd                     |    9 +-
 contrib/osd.lisp               |    2 +-
 contrib/server/test.lisp       |    4 +-
 src/bindings-second-mode.lisp  |    3 +
 src/clfswm-circulate-mode.lisp |   84 +++++++----
 src/clfswm-expose-mode.lisp    |    8 +-
 src/clfswm-internal.lisp       |  179 ++++++++++++-----------
 src/clfswm-layout.lisp         |  104 +++++++-------
 src/clfswm-nw-hooks.lisp       |   38 +++---
 src/clfswm-pack.lisp           |    4 +-
 src/clfswm-placement.lisp      |   18 ++--
 src/clfswm-util.lisp           |  307 ++++++++++++++++++++++------------------
 src/clfswm.lisp                |   19 +--
 src/package.lisp               |    4 +-
 src/xlib-util.lisp             |    6 -
 16 files changed, 424 insertions(+), 370 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 13 21:56:48 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 13 May 2012 14:56:48 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-38-gd5ebccb
Message-ID: <E1STgmW-0002DW-Tc@common-lisp.net>

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  d5ebccb678ccfdeb22c419926ef05298f629fc0d (commit)
      from  793638d4c961bf53cbfa04157e6f6655c2b26979 (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 d5ebccb678ccfdeb22c419926ef05298f629fc0d
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 13 23:56:42 2012 +0200

    src/clfswm-internal.lisp (current-child-setter): Store root current child before apllying current child change.

diff --git a/ChangeLog b/ChangeLog
index de5e677..dd3b082 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,8 @@
 
 	* src/clfswm-internal.lisp: Remove the *current-child* variable
 	and use a setfable function (current-child) instead.
+	(current-child-setter): Store root current child before apllying
+	current child change.
 
 2012-05-09  Philippe Brochard  <pbrochard at common-lisp.net>
 
diff --git a/clfswm.asd b/clfswm.asd
index 98ef92e..edeab21 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -39,7 +39,8 @@
 				:depends-on ("package" "tools" "xlib-util" "clfswm-internal"))
 			 (:file "clfswm-circulate-mode"
 				:depends-on ("xlib-util" "clfswm-keys" "clfswm-generic-mode"
-							 "clfswm-internal" "netwm-util" "tools" "config"))
+							 "clfswm-internal" "netwm-util" "tools" "config"
+                                                         "clfswm-placement"))
 			 (:file "clfswm"
 				:depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
 							 "clfswm-internal" "clfswm-circulate-mode" "tools"))
@@ -47,7 +48,8 @@
 				:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"
 						       "clfswm-placement"))
 			 (:file "clfswm-expose-mode"
-				:depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools" "clfswm-keys" "clfswm-generic-mode"))
+				:depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
+                                                       "clfswm-keys" "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-corner"
 				:depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
 			 (:file "clfswm-info"
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 7e4be5e..e69d8a9 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -387,8 +387,11 @@
   (no-focus)
   (let* ((current-root (find-root (current-child)))
          (parent (find-parent-frame (root-original current-root))))
-    (setf (frame-child parent) (funcall fun (frame-child parent))
-          (current-child) (frame-selected-child parent)))
+    (setf (frame-child parent) (funcall fun (frame-child parent)))
+    (let ((new-root (find-root (frame-selected-child parent))))
+      (setf (current-child) (aif (root-current-child new-root)
+                                 it
+                                 (frame-selected-child parent)))))
   (show-all-children t)
   (leave-second-mode))
 
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index 60c63b7..32cbf37 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -106,33 +106,33 @@
 			 (third lwin))))
 
 (defun expose-create-window (child n)
-  (let* (;;((current-child) child) ;;; PHIL: Broken
-	 (string (format nil "~A~A" (number->string n)
-			 (if *expose-show-window-title*
-			     (format nil " - ~A" (ensure-printable (child-fullname child)))
-			     "")))
-	 (width (if *expose-show-window-title*
-		    (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
-			 (- (child-width child) 4))
-		    (* (xlib:max-char-width *expose-font*) 3)))
-	 (height (* (xlib:font-ascent *expose-font*) 2)))
-    (with-placement (*expose-mode-placement* x y width height)
-      (let* ((window (xlib:create-window :parent *root*
-					 :x x   :y y
-					 :width width   :height height
-					 :background (get-color *expose-background*)
-					 :border-width *border-size*
-					 :border (get-color *expose-border*)
-					 :colormap (xlib:screen-default-colormap *screen*)
-					 :event-mask '(:exposure :key-press)))
-	     (gc (xlib:create-gcontext :drawable window
-				       :foreground (get-color *expose-foreground*)
-				       :background (get-color *expose-background*)
-				       :font *expose-font*
-				       :line-style :solid)))
-        (setf (window-transparency window) *expose-transparency*)
-	(map-window window)
-	(push (list window gc string child) *expose-windows-list*)))))
+  (with-current-child (child)
+    (let* ((string (format nil "~A~A" (number->string n)
+                           (if *expose-show-window-title*
+                               (format nil " - ~A" (ensure-printable (child-fullname child)))
+                               "")))
+           (width (if *expose-show-window-title*
+                      (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
+                           (- (child-width child) 4))
+                      (* (xlib:max-char-width *expose-font*) 3)))
+           (height (* (xlib:font-ascent *expose-font*) 2)))
+      (with-placement (*expose-mode-placement* x y width height)
+        (let* ((window (xlib:create-window :parent *root*
+                                           :x x   :y y
+                                           :width width   :height height
+                                           :background (get-color *expose-background*)
+                                           :border-width *border-size*
+                                           :border (get-color *expose-border*)
+                                           :colormap (xlib:screen-default-colormap *screen*)
+                                           :event-mask '(:exposure :key-press)))
+               (gc (xlib:create-gcontext :drawable window
+                                         :foreground (get-color *expose-foreground*)
+                                         :background (get-color *expose-background*)
+                                         :font *expose-font*
+                                         :line-style :solid)))
+          (setf (window-transparency window) *expose-transparency*)
+          (map-window window)
+          (push (list window gc string child) *expose-windows-list*))))))
 
 
 
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index d71b0ca..2e351d8 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -620,22 +620,6 @@
 ;; TODO: Add find-root-by-coordinates, change-root-geometry
 (let ((root-list nil)
       (current-child nil))
-  (defun current-child ()
-    current-child)
-
-  (defun current-child-setter (value)
-    (setf current-child value))
-
-  (defmacro with-current-child ((new-child) &body body)
-    "Temporarly change the current child"
-    (let ((old-child (gensym))
-          (ret (gensym)))
-      `(let ((,old-child (current-child)))
-         (setf (current-child) ,new-child)
-         (let ((,ret (multiple-value-list (progn , at body))))
-           (setf (current-child) ,old-child)
-           (values-list ,ret)))))
-
   (defun define-as-root (child x y width height)
     (push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
 
@@ -671,7 +655,7 @@
     (aif (child-original-root-p child)
          it
          (awhen (find-parent-frame child)
-                (find-root it))))
+           (find-root it))))
 
   (defun find-child-in-all-root (child)
     (dolist (root root-list)
@@ -679,7 +663,28 @@
         (return-from find-child-in-all-root root))))
 
   (defun find-current-root ()
-    (root-child (find-root (current-child)))))
+    (root-child (find-root (current-child))))
+
+  (defun current-child ()
+    current-child)
+
+  (defun current-child-setter (value)
+    (let ((current-root (find-root current-child)))
+      (dolist (root root-list)
+        (when (equal root current-root)
+          (setf (root-current-child root) current-child))))
+    (setf current-child value))
+
+  (defmacro with-current-child ((new-child) &body body)
+    "Temporarly change the current child"
+    (let ((old-child (gensym))
+          (ret (gensym)))
+      `(let ((,old-child (current-child)))
+         (setf (current-child) ,new-child)
+         (let ((,ret (multiple-value-list (progn , at body))))
+           (setf (current-child) ,old-child)
+           (values-list ,ret)))))
+)
 
 (defsetf current-child current-child-setter)
 

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

Summary of changes:
 ChangeLog                      |    2 +
 clfswm.asd                     |    6 +++-
 src/clfswm-circulate-mode.lisp |    7 +++-
 src/clfswm-expose-mode.lisp    |   54 ++++++++++++++++++++--------------------
 src/clfswm-internal.lisp       |   41 +++++++++++++++++-------------
 5 files changed, 61 insertions(+), 49 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 13 22:08:19 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 13 May 2012 15:08:19 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-39-g2ba6a3e
Message-ID: <E1STgxf-0002tx-D0@common-lisp.net>

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  2ba6a3ec1ce3c59ed674a1ff45cb97b9bfa99426 (commit)
      from  d5ebccb678ccfdeb22c419926ef05298f629fc0d (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 2ba6a3ec1ce3c59ed674a1ff45cb97b9bfa99426
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Mon May 14 00:08:12 2012 +0200

    src/clfswm-internal.lisp (get-connected-heads-size): Do not use fake test code

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 2e351d8..adfc18d 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -704,7 +704,7 @@
                     (parse-integer string :junk-allowed t))
                   (split-string (substitute #\space #\x (substitute #\space #\, line))))))
 
-(defun get-connected-heads-size (&optional (fake t))
+(defun get-connected-heads-size (&optional (fake nil))
   (labels ((heads-info ()
              (if (not fake)
                  (do-shell "xdpyinfo -ext XINERAMA")

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

Summary of changes:
 src/clfswm-internal.lisp |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Tue May 15 20:54:50 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 15 May 2012 13:54:50 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-40-gaef0e41
Message-ID: <E1SUOle-0004PX-B5@common-lisp.net>

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  aef0e417c99264a29d4b53ad71765598204cbe13 (commit)
      from  2ba6a3ec1ce3c59ed674a1ff45cb97b9bfa99426 (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 aef0e417c99264a29d4b53ad71765598204cbe13
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue May 15 22:54:44 2012 +0200

    src/clfswm-circulate-mode.lisp (rotate-root-geometry-next, rotate-root-geometry-previous): New second mode binding to change root geometry.

diff --git a/ChangeLog b/ChangeLog
index dd3b082..119b1cd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-05-15  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-circulate-mode.lisp (rotate-root-geometry-next)
+	(rotate-root-geometry-previous): New second mode binding to change
+	root geometry.
+
 2012-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp: Remove the *current-child* variable
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index 3e4964a..fb98005 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -124,6 +124,8 @@
 
   (define-second-key ("Page_Up") 'select-next-root)
   (define-second-key ("Page_Down") 'select-previous-root)
+  (define-second-key ("Page_Up" :control) 'rotate-root-geometry-next)
+  (define-second-key ("Page_Down" :control) 'rotate-root-geometry-previous)
 
   (define-second-key ("Right") 'speed-mouse-right)
   (define-second-key ("Left") 'speed-mouse-left)
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index e69d8a9..3ec2d95 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -403,3 +403,18 @@
   "Select the previous root"
   (select-generic-root #'anti-rotate-list))
 
+
+(defun rotate-root-geometry-generic (fun)
+  (no-focus)
+  (funcall fun)
+  (show-all-children t)
+  (leave-second-mode))
+
+
+(defun rotate-root-geometry-next ()
+  "Rotate root geometry to next root"
+  (rotate-root-geometry-generic #'rotate-root-geometry))
+
+(defun rotate-root-geometry-previous ()
+  "Rotate root geometry to previous root"
+  (rotate-root-geometry-generic #'anti-rotate-root-geometry))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index adfc18d..4e4199e 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -374,11 +374,6 @@
        , at body)))
 
 
-(defun is-in-current-child-p (child)
-  (and (frame-p (current-child))
-       (child-member child (frame-child (current-child)))))
-
-
 
 ;; (with-all-children (*root-frame* child) (typecase child (xlib:window (print child)) (frame (print (frame-number child)))))
 (defmacro with-all-children ((root child) &body body)
@@ -525,9 +520,6 @@
     (apply #'make-instance 'frame :number number :window window :gc gc args)))
 
 
-
-
-
 (defun add-frame (frame parent)
   (push frame (frame-child parent))
   frame)
@@ -547,22 +539,6 @@
 	    h (h-px->fl prh parent))
       (xlib:display-finish-output *display*))))
 
-(defun fixe-real-size (frame parent)
-  "Fixe real (pixel) coordinates in float coordinates"
-  (when (frame-p frame)
-    (with-slots (x y w h rx ry rw rh) frame
-      (setf x (x-px->fl rx parent)
-	    y (y-px->fl ry parent)
-	    w (w-px->fl (anti-adj-border-wh rw parent) parent)
-	    h (h-px->fl (anti-adj-border-wh rh parent) parent)))))
-
-(defun fixe-real-size-current-child ()
-  "Fixe real (pixel) coordinates in float coordinates for children in the current child"
-  (when (frame-p (current-child))
-    (dolist (child (frame-child (current-child)))
-      (fixe-real-size child (current-child)))))
-
-
 
 
 (defun find-child (to-find root)
@@ -665,14 +641,34 @@
   (defun find-current-root ()
     (root-child (find-root (current-child))))
 
+  (defun rotate-root-geometry ()
+    (let* ((current (first root-list))
+           (orig-x (root-x current))
+           (orig-y (root-y current))
+           (orig-w (root-w current))
+           (orig-h (root-h current)))
+      (dolist (root (rest root-list))
+        (setf (root-x current) (root-x root)
+              (root-y current) (root-y root)
+              (root-w current) (root-w root)
+              (root-h current) (root-h root)
+              current root))
+      (setf (root-x current) orig-x
+            (root-y current) orig-y
+            (root-w current) orig-w
+            (root-h current) orig-h)))
+
+  (defun anti-rotate-root-geometry ()
+    (setf root-list (nreverse root-list))
+    (rotate-root-geometry)
+    (setf root-list (nreverse root-list)))
+
   (defun current-child ()
     current-child)
 
   (defun current-child-setter (value)
-    (let ((current-root (find-root current-child)))
-      (dolist (root root-list)
-        (when (equal root current-root)
-          (setf (root-current-child root) current-child))))
+    (awhen (find-root value)
+      (setf (root-current-child it) value))
     (setf current-child value))
 
   (defmacro with-current-child ((new-child) &body body)
@@ -683,12 +679,32 @@
          (setf (current-child) ,new-child)
          (let ((,ret (multiple-value-list (progn , at body))))
            (setf (current-child) ,old-child)
-           (values-list ,ret)))))
-)
+           (values-list ,ret))))))
 
 (defsetf current-child current-child-setter)
 
 
+(defun is-in-current-child-p (child)
+  (and (frame-p (current-child))
+       (child-member child (frame-child (current-child)))))
+
+
+(defun fixe-real-size (frame parent)
+  "Fixe real (pixel) coordinates in float coordinates"
+  (when (frame-p frame)
+    (with-slots (x y w h rx ry rw rh) frame
+      (setf x (x-px->fl rx parent)
+	    y (y-px->fl ry parent)
+	    w (w-px->fl (anti-adj-border-wh rw parent) parent)
+	    h (h-px->fl (anti-adj-border-wh rh parent) parent)))))
+
+(defun fixe-real-size-current-child ()
+  "Fixe real (pixel) coordinates in float coordinates for children in the current child"
+  (when (frame-p (current-child))
+    (dolist (child (frame-child (current-child)))
+      (fixe-real-size child (current-child)))))
+
+
 
 ;;; Multiple physical screen helper
 (defun add-placed-frame-tmp (frame n)   ;; For test
@@ -704,7 +720,7 @@
                     (parse-integer string :junk-allowed t))
                   (split-string (substitute #\space #\x (substitute #\space #\, line))))))
 
-(defun get-connected-heads-size (&optional (fake nil))
+(defun get-connected-heads-size (&optional (fake t))
   (labels ((heads-info ()
              (if (not fake)
                  (do-shell "xdpyinfo -ext XINERAMA")

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

Summary of changes:
 ChangeLog                      |    6 +++
 src/bindings-second-mode.lisp  |    2 +
 src/clfswm-circulate-mode.lisp |   15 ++++++++
 src/clfswm-internal.lisp       |   78 ++++++++++++++++++++++++----------------
 4 files changed, 70 insertions(+), 31 deletions(-)


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



From pbrochard at common-lisp.net  Tue May 15 22:52:48 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 15 May 2012 15:52:48 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-41-g08028be
Message-ID: <E1SUQbo-0008D5-VQ@common-lisp.net>

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  08028be65be08032cdf474bfa8a4fbbbdaf9715e (commit)
      from  aef0e417c99264a29d4b53ad71765598204cbe13 (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 08028be65be08032cdf474bfa8a4fbbbdaf9715e
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed May 16 00:52:44 2012 +0200

    src/menu-def.lisp: New root menu.

diff --git a/ChangeLog b/ChangeLog
index 119b1cd..127e19c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-05-16  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/menu-def.lisp: New root menu.
+
 2012-05-15  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-circulate-mode.lisp (rotate-root-geometry-next)
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index fb98005..ec9d293 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -52,16 +52,16 @@
   (open-menu (find-menu 'action-by-number-menu)))
 
 (defun open-frame-pack-menu ()
-  "Open the frame pack menu"
-  (open-menu (find-menu 'frame-pack-menu)))
+  "Open the frame pack/fill/resize menu"
+  (open-menu (find-menu 'frame-movement-menu)))
 
-(defun open-frame-fill-menu ()
-  "Open the frame fill menu"
-  (open-menu (find-menu 'frame-fill-menu)))
+(defun open-root-menu ()
+  "Open the root menu"
+  (open-menu (find-menu 'root-menu) nil t))
 
-(defun open-frame-resize-menu ()
-  "Open the frame resize menu"
-  (open-menu (find-menu 'frame-resize-menu)))
+(defun open-child-menu ()
+  "Open the child menu"
+  (open-menu (find-menu 'child-menu)))
 
 (defun tile-current-frame ()
   "Tile the current frame"
@@ -97,8 +97,8 @@
   (define-second-key ("n") 'open-action-by-name-menu)
   (define-second-key ("u") 'open-action-by-number-menu)
   (define-second-key ("p") 'open-frame-pack-menu)
-  (define-second-key ("l") 'open-frame-fill-menu)
-  (define-second-key ("r") 'open-frame-resize-menu)
+  (define-second-key ("r") 'open-root-menu)
+  (define-second-key ("c") 'open-child-menu)
   (define-second-key ("x") 'update-layout-managed-children-position)
   (define-second-key ("g" :control) 'stop-all-pending-actions)
   (define-second-key ("q") 'sm-delete-focus-window)
@@ -108,7 +108,7 @@
   (define-second-key ("exclam") 'run-program-from-query-string)
   (define-second-key ("Return") 'leave-second-mode)
   (define-second-key ("Escape") 'leave-second-mode)
-  (define-second-key ("t") 'tile-current-frame)
+  (define-second-key ("t" :shift) 'tile-current-frame)
   (define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm)
   (define-second-key ("Right" :mod-1) 'select-next-brother)
   (define-second-key ("Left" :mod-1) 'select-previous-brother)
@@ -167,7 +167,7 @@
   (define-second-key ("v" :control :shift) 'paste-selection-no-clear)
   (define-second-key ("Delete" :control) 'remove-current-child)
   (define-second-key ("Delete") 'delete-current-child)
-  (define-shell ("c") b-start-xterm "start an xterm" "cd $HOME && exec xterm")
+  (define-shell ("t") b-start-xterm "start an xterm" "cd $HOME && exec xterm")
   (define-shell ("e") b-start-emacs "start emacs" "cd $HOME && exec emacs")
   (define-shell ("e" :control) b-start-emacsremote
     "start an emacs for another user"
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 4e4199e..26bf269 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -642,21 +642,26 @@
     (root-child (find-root (current-child))))
 
   (defun rotate-root-geometry ()
-    (let* ((current (first root-list))
-           (orig-x (root-x current))
-           (orig-y (root-y current))
-           (orig-w (root-w current))
-           (orig-h (root-h current)))
-      (dolist (root (rest root-list))
-        (setf (root-x current) (root-x root)
-              (root-y current) (root-y root)
-              (root-w current) (root-w root)
-              (root-h current) (root-h root)
-              current root))
-      (setf (root-x current) orig-x
-            (root-y current) orig-y
-            (root-w current) orig-w
-            (root-h current) orig-h)))
+    (let* ((first (first root-list))
+           (len (length root-list))
+           (orig-x (root-x first))
+           (orig-y (root-y first))
+           (orig-w (root-w first))
+           (orig-h (root-h first)))
+      (dotimes (i (1- len))
+        (let ((root-1 (nth i root-list))
+              (root-2 (nth (1+ i) root-list)))
+          (rotatef (root-x root-1) (root-x root-2))
+          (rotatef (root-y root-1) (root-y root-2))
+          (rotatef (root-w root-1) (root-w root-2))
+          (rotatef (root-h root-1) (root-h root-2))))
+      (let ((root-1 (nth (1- len) root-list)))
+        (setf (root-x root-1) orig-x)
+        (setf (root-y root-1) orig-y)
+        (setf (root-w root-1) orig-w)
+        (setf (root-h root-1) orig-h))))
+
+
 
   (defun anti-rotate-root-geometry ()
     (setf root-list (nreverse root-list))
diff --git a/src/clfswm-menu.lisp b/src/clfswm-menu.lisp
index d2dc6e7..a629eed 100644
--- a/src/clfswm-menu.lisp
+++ b/src/clfswm-menu.lisp
@@ -137,33 +137,37 @@
 	 (funcall action)))))
 
 
-(defun open-menu (&optional (menu *menu*) (parent nil))
+(defun open-menu (&optional (menu *menu*) (parent nil) (restart-menu nil))
   "Open the main menu"
-  (let ((action nil)
-        (old-info-keys (copy-hash-table *info-keys*)))
-    (labels ((populate-menu ()
-	       (let ((info-list nil))
-		 (dolist (item (menu-item menu))
-		   (let ((value (menu-item-value item)))
-		     (push (typecase value
-			     (menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*)
-					 (list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*)))
-			     (string (list (list (format nil "~A" (menu-item-value item)) *menu-color-comment*)))
-			     (t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*)
-				      (format nil ": ~A" (documentation value 'function)))))
-			   info-list)
-		     (when (menu-item-key item)
-		       (define-info-key-fun (list (menu-item-key item))
-			   (lambda (&optional args)
-			     (declare (ignore args))
-			     (setf action value)
-			     (leave-info-mode nil))))))
-		 (nreverse info-list))))
-      (let ((selected-item (info-mode (populate-menu))))
-        (setf *info-keys* old-info-keys)
-	(when selected-item
-	  (awhen (nth selected-item (menu-item menu))
-	    (setf action (menu-item-value it)))))
-      (open-menu-do-action action menu parent))))
+  (when menu
+    (let ((action nil)
+          (old-info-keys (copy-hash-table *info-keys*)))
+      (labels ((populate-menu ()
+                 (let ((info-list nil))
+                   (dolist (item (menu-item menu))
+                     (let ((value (menu-item-value item)))
+                       (push (typecase value
+                               (menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*)
+                                           (list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*)))
+                               (string (list (list (format nil "~A" (menu-item-value item)) *menu-color-comment*)))
+                               (t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*)
+                                        (format nil ": ~A" (documentation value 'function)))))
+                             info-list)
+                       (when (menu-item-key item)
+                         (define-info-key-fun (list (menu-item-key item))
+                             (lambda (&optional args)
+                               (declare (ignore args))
+                               (setf action value)
+                               (leave-info-mode nil))))))
+                   (nreverse info-list))))
+        (let ((selected-item (info-mode (populate-menu))))
+          (setf *info-keys* old-info-keys)
+          (when selected-item
+            (awhen (nth selected-item (menu-item menu))
+              (setf action (menu-item-value it)))))
+        (let ((*in-second-mode* (if restart-menu nil *in-second-mode*)))
+          (open-menu-do-action action menu parent))
+        (when (and action restart-menu)
+          (open-menu menu parent restart-menu))))))
 
 
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index 7a075a9..00fffa6 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -38,47 +38,51 @@
 
 (defun find-edge-up (current-frame parent)
   (let ((y-found 0))
-    (dolist (frame (frame-child parent))
-      (when (and (frame-p frame)
-		 (not (equal frame current-frame))
-		 (<= (frame-y2 frame) (frame-y current-frame))
-		 (>= (frame-x2 frame) (frame-x current-frame))
-		 (<= (frame-x frame) (frame-x2 current-frame)))
-	(setf y-found (max y-found (frame-y2 frame)))))
+    (when parent
+      (dolist (frame (frame-child parent))
+        (when (and (frame-p frame)
+                   (not (equal frame current-frame))
+                   (<= (frame-y2 frame) (frame-y current-frame))
+                   (>= (frame-x2 frame) (frame-x current-frame))
+                   (<= (frame-x frame) (frame-x2 current-frame)))
+          (setf y-found (max y-found (frame-y2 frame))))))
     y-found))
 
 (defun find-edge-down (current-frame parent)
   (let ((y-found 1))
-    (dolist (frame (frame-child parent))
-      (when (and (frame-p frame)
-		 (not (equal frame current-frame))
-		 (>= (frame-y frame) (frame-y2 current-frame))
-		 (>= (frame-x2 frame) (frame-x current-frame))
-		 (<= (frame-x frame) (frame-x2 current-frame)))
-	(setf y-found (min y-found (frame-y frame)))))
+    (when parent
+      (dolist (frame (frame-child parent))
+        (when (and (frame-p frame)
+                   (not (equal frame current-frame))
+                   (>= (frame-y frame) (frame-y2 current-frame))
+                   (>= (frame-x2 frame) (frame-x current-frame))
+                   (<= (frame-x frame) (frame-x2 current-frame)))
+          (setf y-found (min y-found (frame-y frame))))))
     y-found))
 
 (defun find-edge-right (current-frame parent)
   (let ((x-found 1))
-    (dolist (frame (frame-child parent))
-      (when (and (frame-p frame)
-		 (not (equal frame current-frame))
-		 (>= (frame-x frame) (frame-x2 current-frame))
-		 (>= (frame-y2 frame) (frame-y current-frame))
-		 (<= (frame-y frame) (frame-y2 current-frame)))
-	(setf x-found (min x-found (frame-x frame)))))
+    (when parent
+      (dolist (frame (frame-child parent))
+        (when (and (frame-p frame)
+                   (not (equal frame current-frame))
+                   (>= (frame-x frame) (frame-x2 current-frame))
+                   (>= (frame-y2 frame) (frame-y current-frame))
+                   (<= (frame-y frame) (frame-y2 current-frame)))
+          (setf x-found (min x-found (frame-x frame))))))
     x-found))
 
 
 (defun find-edge-left (current-frame parent)
   (let ((x-found 0))
-    (dolist (frame (frame-child parent))
-      (when (and (frame-p frame)
-		 (not (equal frame current-frame))
-		 (<= (frame-x2 frame) (frame-x current-frame))
-		 (>= (frame-y2 frame) (frame-y current-frame))
-		 (<= (frame-y frame) (frame-y2 current-frame)))
-	(setf x-found (max x-found (frame-x2 frame)))))
+    (when parent
+      (dolist (frame (frame-child parent))
+        (when (and (frame-p frame)
+                   (not (equal frame current-frame))
+                   (<= (frame-x2 frame) (frame-x current-frame))
+                   (>= (frame-y2 frame) (frame-y current-frame))
+                   (<= (frame-y frame) (frame-y2 current-frame)))
+          (setf x-found (max x-found (frame-x2 frame))))))
     x-found))
 
 
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index f5f1f6e..43799be 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -50,6 +50,7 @@
 (add-sub-menu 'main "F1" 'help-menu "Help menu")
 (add-sub-menu 'main "d" 'standard-menu "Standard menu")
 (add-sub-menu 'main "c" 'child-menu "Child menu")
+(add-sub-menu 'main "r" 'root-menu "Root menu")
 (add-sub-menu 'main "f" 'frame-menu "Frame menu")
 (add-sub-menu 'main "w" 'window-menu "Window menu")
 (add-sub-menu 'main "s" 'selection-menu "Selection menu")
@@ -89,6 +90,11 @@
 (add-menu-key 'child-menu "Page_Up" 'frame-lower-child)
 (add-menu-key 'child-menu "Page_Down" 'frame-raise-child)
 
+(add-menu-key 'root-menu "n" 'select-next-root)
+(add-menu-key 'root-menu "p" 'select-previous-root)
+(add-menu-key 'root-menu "g" 'rotate-root-geometry-next)
+(add-menu-key 'root-menu "f" 'rotate-root-geometry-previous)
+(add-menu-key 'root-menu "m" 'exchange-root-geometry-with-mouse)
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")

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

Summary of changes:
 ChangeLog                     |    4 +++
 src/bindings-second-mode.lisp |   24 ++++++++--------
 src/clfswm-internal.lisp      |   35 +++++++++++++----------
 src/clfswm-menu.lisp          |   58 +++++++++++++++++++++------------------
 src/clfswm-pack.lisp          |   60 ++++++++++++++++++++++-------------------
 src/menu-def.lisp             |    6 ++++
 6 files changed, 105 insertions(+), 82 deletions(-)


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



From pbrochard at common-lisp.net  Wed May 16 22:14:45 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 16 May 2012 15:14:45 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-42-g3ae4f17
Message-ID: <E1SUmUX-0002Jg-6I@common-lisp.net>

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  3ae4f173168644e1a9f51ed9140470e2603aae0a (commit)
      from  08028be65be08032cdf474bfa8a4fbbbdaf9715e (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 3ae4f173168644e1a9f51ed9140470e2603aae0a
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu May 17 00:14:38 2012 +0200

    src/clfswm-util.lisp (exchange-root-geometry-with-mouse): New function and menu.

diff --git a/ChangeLog b/ChangeLog
index 127e19c..2c24f0c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (exchange-root-geometry-with-mouse): New
+	function and menu.
+
 2012-05-16  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/menu-def.lisp: New root menu.
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index ec9d293..e9387c3 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -57,7 +57,7 @@
 
 (defun open-root-menu ()
   "Open the root menu"
-  (open-menu (find-menu 'root-menu) nil t))
+  (open-menu (find-menu 'root-menu)))
 
 (defun open-child-menu ()
   "Open the child menu"
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 3ec2d95..2771d7e 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -381,40 +381,3 @@
                                                        (middle-child-x child) (child-y2 child))))))
 
 
-
-
-(defun select-generic-root (fun)
-  (no-focus)
-  (let* ((current-root (find-root (current-child)))
-         (parent (find-parent-frame (root-original current-root))))
-    (setf (frame-child parent) (funcall fun (frame-child parent)))
-    (let ((new-root (find-root (frame-selected-child parent))))
-      (setf (current-child) (aif (root-current-child new-root)
-                                 it
-                                 (frame-selected-child parent)))))
-  (show-all-children t)
-  (leave-second-mode))
-
-(defun select-next-root ()
-  "Select the next root"
-  (select-generic-root #'rotate-list))
-
-(defun select-previous-root ()
-  "Select the previous root"
-  (select-generic-root #'anti-rotate-list))
-
-
-(defun rotate-root-geometry-generic (fun)
-  (no-focus)
-  (funcall fun)
-  (show-all-children t)
-  (leave-second-mode))
-
-
-(defun rotate-root-geometry-next ()
-  "Rotate root geometry to next root"
-  (rotate-root-geometry-generic #'rotate-root-geometry))
-
-(defun rotate-root-geometry-previous ()
-  "Rotate root geometry to previous root"
-  (rotate-root-geometry-generic #'anti-rotate-root-geometry))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 26bf269..440321a 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -641,6 +641,12 @@
   (defun find-current-root ()
     (root-child (find-root (current-child))))
 
+  (defun exchange-root-geometry (root-1 root-2)
+    (rotatef (root-x root-1) (root-x root-2))
+    (rotatef (root-y root-1) (root-y root-2))
+    (rotatef (root-w root-1) (root-w root-2))
+    (rotatef (root-h root-1) (root-h root-2)))
+
   (defun rotate-root-geometry ()
     (let* ((first (first root-list))
            (len (length root-list))
@@ -649,12 +655,7 @@
            (orig-w (root-w first))
            (orig-h (root-h first)))
       (dotimes (i (1- len))
-        (let ((root-1 (nth i root-list))
-              (root-2 (nth (1+ i) root-list)))
-          (rotatef (root-x root-1) (root-x root-2))
-          (rotatef (root-y root-1) (root-y root-2))
-          (rotatef (root-w root-1) (root-w root-2))
-          (rotatef (root-h root-1) (root-h root-2))))
+        (exchange-root-geometry (nth i root-list) (nth (1+ i) root-list)))
       (let ((root-1 (nth (1- len) root-list)))
         (setf (root-x root-1) orig-x)
         (setf (root-y root-1) orig-y)
@@ -662,12 +663,12 @@
         (setf (root-h root-1) orig-h))))
 
 
-
   (defun anti-rotate-root-geometry ()
     (setf root-list (nreverse root-list))
     (rotate-root-geometry)
     (setf root-list (nreverse root-list)))
 
+  ;;; Current child functions
   (defun current-child ()
     current-child)
 
diff --git a/src/clfswm-menu.lisp b/src/clfswm-menu.lisp
index a629eed..3574773 100644
--- a/src/clfswm-menu.lisp
+++ b/src/clfswm-menu.lisp
@@ -137,7 +137,7 @@
 	 (funcall action)))))
 
 
-(defun open-menu (&optional (menu *menu*) (parent nil) (restart-menu nil))
+(defun open-menu (&optional (menu *menu*) (parent nil))
   "Open the main menu"
   (when menu
     (let ((action nil)
@@ -165,9 +165,6 @@
           (when selected-item
             (awhen (nth selected-item (menu-item menu))
               (setf action (menu-item-value it)))))
-        (let ((*in-second-mode* (if restart-menu nil *in-second-mode*)))
-          (open-menu-do-action action menu parent))
-        (when (and action restart-menu)
-          (open-menu menu parent restart-menu))))))
+        (open-menu-do-action action menu parent)))))
 
 
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 8bc4c62..88c4594 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1722,3 +1722,81 @@ For window: set current child to window or its parent according to window-parent
 (defun anti-rotate-frame-geometry ()
   "Anti rotate brother frame geometry"
   (rotate-frame-geometry-generic #'reverse))
+
+
+;;; Root functions utility
+(defun select-generic-root (fun restart-menu)
+  (no-focus)
+  (let* ((current-root (find-root (current-child)))
+         (parent (find-parent-frame (root-original current-root))))
+    (setf (frame-child parent) (funcall fun (frame-child parent)))
+    (let ((new-root (find-root (frame-selected-child parent))))
+      (setf (current-child) (aif (root-current-child new-root)
+                                 it
+                                 (frame-selected-child parent)))))
+  (show-all-children t)
+  (if restart-menu
+      (open-menu (find-menu 'root-menu))
+      (leave-second-mode)))
+
+(defun select-next-root ()
+  "Select the next root"
+  (select-generic-root #'rotate-list nil))
+
+(defun select-previous-root ()
+  "Select the previous root"
+  (select-generic-root #'anti-rotate-list nil))
+
+
+(defun select-next-root-restart-menu ()
+  "Select the next root"
+  (select-generic-root #'rotate-list t))
+
+(defun select-previous-root-restart-menu ()
+  "Select the previous root"
+  (select-generic-root #'anti-rotate-list t))
+
+
+(defun rotate-root-geometry-generic (fun restart-menu)
+  (no-focus)
+  (funcall fun)
+  (show-all-children t)
+  (if restart-menu
+      (open-menu (find-menu 'root-menu))
+      (leave-second-mode)))
+
+
+(defun rotate-root-geometry-next ()
+  "Rotate root geometry to next root"
+  (rotate-root-geometry-generic #'rotate-root-geometry nil))
+
+(defun rotate-root-geometry-previous ()
+  "Rotate root geometry to previous root"
+  (rotate-root-geometry-generic #'anti-rotate-root-geometry nil))
+
+(defun rotate-root-geometry-next-restart-menu ()
+  "Rotate root geometry to next root"
+  (rotate-root-geometry-generic #'rotate-root-geometry t))
+
+(defun rotate-root-geometry-previous-restart-menu ()
+  "Rotate root geometry to previous root"
+  (rotate-root-geometry-generic #'anti-rotate-root-geometry t))
+
+
+
+(defun exchange-root-geometry-with-mouse ()
+  "Exchange two root geometry pointed with the mouse"
+  (open-notify-window '("Select the first root to exchange"))
+  (wait-no-key-or-button-press)
+  (wait-mouse-button-release)
+  (close-notify-window)
+  (multiple-value-bind (x1 y1) (xlib:query-pointer *root*)
+    (open-notify-window '("Select the second root to exchange"))
+    (wait-no-key-or-button-press)
+    (wait-mouse-button-release)
+    (close-notify-window)
+    (multiple-value-bind (x2 y2) (xlib:query-pointer *root*)
+      (exchange-root-geometry (find-root-by-coordinates x1 y1)
+                              (find-root-by-coordinates x2 y2))))
+  (leave-second-mode))
+
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index 43799be..c1049e4 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -90,10 +90,10 @@
 (add-menu-key 'child-menu "Page_Up" 'frame-lower-child)
 (add-menu-key 'child-menu "Page_Down" 'frame-raise-child)
 
-(add-menu-key 'root-menu "n" 'select-next-root)
-(add-menu-key 'root-menu "p" 'select-previous-root)
-(add-menu-key 'root-menu "g" 'rotate-root-geometry-next)
-(add-menu-key 'root-menu "f" 'rotate-root-geometry-previous)
+(add-menu-key 'root-menu "n" 'select-next-root-restart-menu)
+(add-menu-key 'root-menu "p" 'select-previous-root-restart-menu)
+(add-menu-key 'root-menu "g" 'rotate-root-geometry-next-restart-menu)
+(add-menu-key 'root-menu "f" 'rotate-root-geometry-previous-restart-menu)
 (add-menu-key 'root-menu "m" 'exchange-root-geometry-with-mouse)
 
 

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

Summary of changes:
 ChangeLog                      |    5 +++
 src/bindings-second-mode.lisp  |    2 +-
 src/clfswm-circulate-mode.lisp |   37 -------------------
 src/clfswm-internal.lisp       |   15 ++++----
 src/clfswm-menu.lisp           |    7 +---
 src/clfswm-util.lisp           |   78 ++++++++++++++++++++++++++++++++++++++++
 src/menu-def.lisp              |    8 ++--
 7 files changed, 98 insertions(+), 54 deletions(-)


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



From pbrochard at common-lisp.net  Wed May 16 22:19:20 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 16 May 2012 15:19:20 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-43-g21b53b3
Message-ID: <E1SUmYy-0002vd-LB@common-lisp.net>

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  21b53b3f04745a661d8a881bccde644eb1c08065 (commit)
      from  3ae4f173168644e1a9f51ed9140470e2603aae0a (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 21b53b3f04745a661d8a881bccde644eb1c08065
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu May 17 00:19:14 2012 +0200

    remove fake test

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 440321a..de7d85e 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -726,7 +726,7 @@
                     (parse-integer string :junk-allowed t))
                   (split-string (substitute #\space #\x (substitute #\space #\, line))))))
 
-(defun get-connected-heads-size (&optional (fake t))
+(defun get-connected-heads-size (&optional (fake nil))
   (labels ((heads-info ()
              (if (not fake)
                  (do-shell "xdpyinfo -ext XINERAMA")

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

Summary of changes:
 src/clfswm-internal.lisp |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Thu May 17 08:59:29 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Thu, 17 May 2012 01:59:29 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-44-g32642a7
Message-ID: <E1SUwYT-0004hz-E3@common-lisp.net>

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  32642a72d744e6cca2f6196c9fda1fbc7eee4d5f (commit)
      from  21b53b3f04745a661d8a881bccde644eb1c08065 (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 32642a72d744e6cca2f6196c9fda1fbc7eee4d5f
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu May 17 10:59:22 2012 +0200

    minor check for root

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index de7d85e..facf8e4 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -642,10 +642,11 @@
     (root-child (find-root (current-child))))
 
   (defun exchange-root-geometry (root-1 root-2)
-    (rotatef (root-x root-1) (root-x root-2))
-    (rotatef (root-y root-1) (root-y root-2))
-    (rotatef (root-w root-1) (root-w root-2))
-    (rotatef (root-h root-1) (root-h root-2)))
+    (when (and root-1 root-2)
+      (rotatef (root-x root-1) (root-x root-2))
+      (rotatef (root-y root-1) (root-y root-2))
+      (rotatef (root-w root-1) (root-w root-2))
+      (rotatef (root-h root-1) (root-h root-2))))
 
   (defun rotate-root-geometry ()
     (let* ((first (first root-list))
@@ -726,7 +727,7 @@
                     (parse-integer string :junk-allowed t))
                   (split-string (substitute #\space #\x (substitute #\space #\, line))))))
 
-(defun get-connected-heads-size (&optional (fake nil))
+(defun get-connected-heads-size (&optional (fake (string= (getenv "DISPLAY") ":1")))
   (labels ((heads-info ()
              (if (not fake)
                  (do-shell "xdpyinfo -ext XINERAMA")
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 88c4594..20ad0c7 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1729,11 +1729,12 @@ For window: set current child to window or its parent according to window-parent
   (no-focus)
   (let* ((current-root (find-root (current-child)))
          (parent (find-parent-frame (root-original current-root))))
-    (setf (frame-child parent) (funcall fun (frame-child parent)))
-    (let ((new-root (find-root (frame-selected-child parent))))
-      (setf (current-child) (aif (root-current-child new-root)
-                                 it
-                                 (frame-selected-child parent)))))
+    (when parent
+      (setf (frame-child parent) (funcall fun (frame-child parent)))
+      (let ((new-root (find-root (frame-selected-child parent))))
+        (setf (current-child) (aif (root-current-child new-root)
+                                   it
+                                   (frame-selected-child parent))))))
   (show-all-children t)
   (if restart-menu
       (open-menu (find-menu 'root-menu))
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index c1049e4..fcd508b 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -94,7 +94,7 @@
 (add-menu-key 'root-menu "p" 'select-previous-root-restart-menu)
 (add-menu-key 'root-menu "g" 'rotate-root-geometry-next-restart-menu)
 (add-menu-key 'root-menu "f" 'rotate-root-geometry-previous-restart-menu)
-(add-menu-key 'root-menu "m" 'exchange-root-geometry-with-mouse)
+(add-menu-key 'root-menu "x" 'exchange-root-geometry-with-mouse)
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")

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

Summary of changes:
 src/clfswm-internal.lisp |   11 ++++++-----
 src/clfswm-util.lisp     |   11 ++++++-----
 src/menu-def.lisp        |    2 +-
 3 files changed, 13 insertions(+), 11 deletions(-)


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



From pbrochard at common-lisp.net  Fri May 18 20:35:18 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 18 May 2012 13:35:18 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-45-g0eb8c34
Message-ID: <E1SVTtO-0004Bb-JV@common-lisp.net>

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  0eb8c3465bd8baadeeef7ca426eba63f74e35400 (commit)
      from  32642a72d744e6cca2f6196c9fda1fbc7eee4d5f (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 0eb8c3465bd8baadeeef7ca426eba63f74e35400
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Fri May 18 22:35:12 2012 +0200

    src/clfswm-util.lisp (change-current-root-geometry): New efunction.

diff --git a/ChangeLog b/ChangeLog
index 2c24f0c..8e29683 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-18  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (change-current-root-geometry): New
+	function.
+
 2012-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (exchange-root-geometry-with-mouse): New
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index 7838bb2..9e72529 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -337,4 +337,8 @@
 
 (defun query-number (msg &optional (default 0))
   "Query a number from the query input"
-  (parse-integer (or (query-string msg (format nil "~A" default)) "") :junk-allowed t))
+  (multiple-value-bind (string return)
+      (query-string msg (format nil "~A" default))
+    (if (equal return :Return)
+        (or (parse-integer (or string "") :junk-allowed t) default)
+        default)))
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 20ad0c7..6a51df7 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -78,6 +78,98 @@
     (xlib:warp-pointer *root* x y)))
 
 
+
+
+;;; Root functions utility
+(defun select-generic-root (fun restart-menu)
+  (no-focus)
+  (let* ((current-root (find-root (current-child)))
+         (parent (find-parent-frame (root-original current-root))))
+    (when parent
+      (setf (frame-child parent) (funcall fun (frame-child parent)))
+      (let ((new-root (find-root (frame-selected-child parent))))
+        (setf (current-child) (aif (root-current-child new-root)
+                                   it
+                                   (frame-selected-child parent))))))
+  (show-all-children t)
+  (if restart-menu
+      (open-menu (find-menu 'root-menu))
+      (leave-second-mode)))
+
+(defun select-next-root ()
+  "Select the next root"
+  (select-generic-root #'rotate-list nil))
+
+(defun select-previous-root ()
+  "Select the previous root"
+  (select-generic-root #'anti-rotate-list nil))
+
+
+(defun select-next-root-restart-menu ()
+  "Select the next root"
+  (select-generic-root #'rotate-list t))
+
+(defun select-previous-root-restart-menu ()
+  "Select the previous root"
+  (select-generic-root #'anti-rotate-list t))
+
+
+(defun rotate-root-geometry-generic (fun restart-menu)
+  (no-focus)
+  (funcall fun)
+  (show-all-children t)
+  (if restart-menu
+      (open-menu (find-menu 'root-menu))
+      (leave-second-mode)))
+
+
+(defun rotate-root-geometry-next ()
+  "Rotate root geometry to next root"
+  (rotate-root-geometry-generic #'rotate-root-geometry nil))
+
+(defun rotate-root-geometry-previous ()
+  "Rotate root geometry to previous root"
+  (rotate-root-geometry-generic #'anti-rotate-root-geometry nil))
+
+(defun rotate-root-geometry-next-restart-menu ()
+  "Rotate root geometry to next root"
+  (rotate-root-geometry-generic #'rotate-root-geometry t))
+
+(defun rotate-root-geometry-previous-restart-menu ()
+  "Rotate root geometry to previous root"
+  (rotate-root-geometry-generic #'anti-rotate-root-geometry t))
+
+
+
+(defun exchange-root-geometry-with-mouse ()
+  "Exchange two root geometry pointed with the mouse"
+  (open-notify-window '("Select the first root to exchange"))
+  (wait-no-key-or-button-press)
+  (wait-mouse-button-release)
+  (close-notify-window)
+  (multiple-value-bind (x1 y1) (xlib:query-pointer *root*)
+    (open-notify-window '("Select the second root to exchange"))
+    (wait-no-key-or-button-press)
+    (wait-mouse-button-release)
+    (close-notify-window)
+    (multiple-value-bind (x2 y2) (xlib:query-pointer *root*)
+      (exchange-root-geometry (find-root-by-coordinates x1 y1)
+                              (find-root-by-coordinates x2 y2))))
+  (leave-second-mode))
+
+(defun change-current-root-geometry ()
+  "Change the current root geometry"
+  (let* ((root (find-root (current-child)))
+         (x (query-number "New root X position" (root-x root)))
+         (y (query-number "New root Y position" (root-y root)))
+         (w (query-number "New root width" (root-w root)))
+         (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)))
+
+
+
 (defun place-window-from-hints (window)
   "Place a window from its hints"
   (let* ((hints (xlib:wm-normal-hints window))
@@ -1723,81 +1815,3 @@ For window: set current child to window or its parent according to window-parent
   "Anti rotate brother frame geometry"
   (rotate-frame-geometry-generic #'reverse))
 
-
-;;; Root functions utility
-(defun select-generic-root (fun restart-menu)
-  (no-focus)
-  (let* ((current-root (find-root (current-child)))
-         (parent (find-parent-frame (root-original current-root))))
-    (when parent
-      (setf (frame-child parent) (funcall fun (frame-child parent)))
-      (let ((new-root (find-root (frame-selected-child parent))))
-        (setf (current-child) (aif (root-current-child new-root)
-                                   it
-                                   (frame-selected-child parent))))))
-  (show-all-children t)
-  (if restart-menu
-      (open-menu (find-menu 'root-menu))
-      (leave-second-mode)))
-
-(defun select-next-root ()
-  "Select the next root"
-  (select-generic-root #'rotate-list nil))
-
-(defun select-previous-root ()
-  "Select the previous root"
-  (select-generic-root #'anti-rotate-list nil))
-
-
-(defun select-next-root-restart-menu ()
-  "Select the next root"
-  (select-generic-root #'rotate-list t))
-
-(defun select-previous-root-restart-menu ()
-  "Select the previous root"
-  (select-generic-root #'anti-rotate-list t))
-
-
-(defun rotate-root-geometry-generic (fun restart-menu)
-  (no-focus)
-  (funcall fun)
-  (show-all-children t)
-  (if restart-menu
-      (open-menu (find-menu 'root-menu))
-      (leave-second-mode)))
-
-
-(defun rotate-root-geometry-next ()
-  "Rotate root geometry to next root"
-  (rotate-root-geometry-generic #'rotate-root-geometry nil))
-
-(defun rotate-root-geometry-previous ()
-  "Rotate root geometry to previous root"
-  (rotate-root-geometry-generic #'anti-rotate-root-geometry nil))
-
-(defun rotate-root-geometry-next-restart-menu ()
-  "Rotate root geometry to next root"
-  (rotate-root-geometry-generic #'rotate-root-geometry t))
-
-(defun rotate-root-geometry-previous-restart-menu ()
-  "Rotate root geometry to previous root"
-  (rotate-root-geometry-generic #'anti-rotate-root-geometry t))
-
-
-
-(defun exchange-root-geometry-with-mouse ()
-  "Exchange two root geometry pointed with the mouse"
-  (open-notify-window '("Select the first root to exchange"))
-  (wait-no-key-or-button-press)
-  (wait-mouse-button-release)
-  (close-notify-window)
-  (multiple-value-bind (x1 y1) (xlib:query-pointer *root*)
-    (open-notify-window '("Select the second root to exchange"))
-    (wait-no-key-or-button-press)
-    (wait-mouse-button-release)
-    (close-notify-window)
-    (multiple-value-bind (x2 y2) (xlib:query-pointer *root*)
-      (exchange-root-geometry (find-root-by-coordinates x1 y1)
-                              (find-root-by-coordinates x2 y2))))
-  (leave-second-mode))
-
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index fcd508b..593038b 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -95,6 +95,7 @@
 (add-menu-key 'root-menu "g" 'rotate-root-geometry-next-restart-menu)
 (add-menu-key 'root-menu "f" 'rotate-root-geometry-previous-restart-menu)
 (add-menu-key 'root-menu "x" 'exchange-root-geometry-with-mouse)
+(add-menu-key 'root-menu "r" 'change-current-root-geometry)
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")

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

Summary of changes:
 ChangeLog             |    5 ++
 src/clfswm-query.lisp |    6 ++-
 src/clfswm-util.lisp  |  170 ++++++++++++++++++++++++++----------------------
 src/menu-def.lisp     |    1 +
 4 files changed, 103 insertions(+), 79 deletions(-)


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



From pbrochard at common-lisp.net  Fri May 18 21:06:01 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 18 May 2012 14:06:01 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-46-g7e8581d
Message-ID: <E1SVUN7-0006hS-6N@common-lisp.net>

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



From pbrochard at common-lisp.net  Sat May 19 20:19:29 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 19 May 2012 13:19:29 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-47-g21b78de
Message-ID: <E1SVq7d-0002VK-CH@common-lisp.net>

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  21b78de6e93ed43a5654746d6037222db575c51f (commit)
      from  7e8581d49cf750448628d8bebe3db5be96914efb (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 21b78de6e93ed43a5654746d6037222db575c51f
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sat May 19 22:19:23 2012 +0200

    src/clfswm-placement.lisp: Adjust width and height in child and root placement to prevent too big child size.

diff --git a/ChangeLog b/ChangeLog
index 27dd28f..1aeeb18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-19  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-placement.lisp: Adjust width and height in child and
+	root placement to prevent too big child size.
+
 2012-05-18  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-placement.lisp: New root placement possibility.
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 44bb756..611cf0b 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -27,18 +27,18 @@
 
 (defun get-placement-values (placement &optional (width 0) (height 0))
   (typecase placement
-    (list (values (first placement)
-		  (second placement)))
+    (list (values-list placement))
     (function (funcall placement width height))
     (symbol
      (if (fboundp placement)
 	 (funcall placement width height)
-	 (values 0 0)))
-    (t (values 0 0))))
+	 (values 0 0 width height)))
+    (t (values 0 0 width height))))
 
 (defmacro with-placement ((placement x y &optional (width 0) (height 0)) &body body)
-  `(multiple-value-bind (,x ,y)
+  `(multiple-value-bind (,x ,y width height)
        (get-placement-values ,placement ,width ,height)
+     (declare (ignorable width height))
      , at body))
 
 ;;;; Test functions
@@ -59,47 +59,50 @@
 ;;; Absolute placement
 ;;;
 (defun top-left-placement (&optional (width 0) (height 0))
-  (declare (ignore width height))
-  (values 0 0))
+  (values 0 0 width height))
 
 (defun top-middle-placement (&optional (width 0) (height 0))
-  (declare (ignore height))
   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
-	  0))
+	  0
+          width height))
 
 (defun top-right-placement (&optional (width 0) (height 0))
-  (declare (ignore height))
   (values (- (xlib:screen-width *screen*) width (* *border-size* 2))
-	  0))
+	  0
+          width height))
 
 
 
 (defun middle-left-placement (&optional (width 0) (height 0))
-  (declare (ignore width))
   (values 0
-	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))
+          width height))
 
 (defun middle-middle-placement (&optional (width 0) (height 0))
   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
-	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))
+          width height))
 
 (defun middle-right-placement (&optional (width 0) (height 0))
   (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))
-  (declare (ignore width))
   (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))
   (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))
   (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))
 
 
 ;;;
@@ -124,62 +127,79 @@
 
 
 (defun top-left-child-placement (&optional (width 0) (height 0))
-  (declare (ignore width height))
   (with-current-child-coord (x y w h)
-    (declare (ignore w h))
-    (values (+ x 2)
-	    (+ y 2))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y 2)
+              width height))))
 
 (defun top-middle-child-placement (&optional (width 0) (height 0))
-  (declare (ignore height))
   (with-current-child-coord (x y w h)
-    (declare (ignore h))
-    (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y 2))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y 2)
+              width height))))
 
 (defun top-right-child-placement (&optional (width 0) (height 0))
-  (declare (ignore height))
   (with-current-child-coord (x y w h)
-    (declare (ignore h))
-    (values (+ x (- w width 2))
-	    (+ y 2))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y 2)
+              width height))))
 
 
 
 (defun middle-left-child-placement (&optional (width 0) (height 0))
-  (declare (ignore width))
   (with-current-child-coord (x y w h)
-    (declare (ignore w))
-    (values (+ x 2)
-	    (+ y (truncate (/ (- h height) 2))))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 (defun middle-middle-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y (truncate (/ (- h height) 2))))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 (defun middle-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width 2))
-	    (+ y (truncate (/ (- h height) 2))))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 
 (defun bottom-left-child-placement (&optional (width 0) (height 0))
-  (declare (ignore width))
   (with-current-child-coord (x y w h)
-    (declare (ignore w))
-    (values (+ x 2)
-	    (+ y (- h height 2)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y (- h height 2))
+              width height))))
 
 (defun bottom-middle-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y (- h height 2)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y (- h height 2))
+              width height))))
 
 (defun bottom-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width 2))
-	    (+ y (- h height 2)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y (- h height 2))
+              width height))))
 
 
 ;;;
@@ -198,60 +218,77 @@
 
 
 (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))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y 2)
+              width height))))
 
 (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))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y 2)
+              width height))))
 
 (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))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y 2)
+              width height))))
 
 
 
 (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))))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 (defun middle-middle-root-placement (&optional (width 0) (height 0))
   (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))))))
+	    (+ y (truncate (/ (- h height) 2)))
+            width height))))
 
 (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))))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y (truncate (/ (- h height) 2)))
+              width height))))
 
 
 (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)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x 2)
+              (+ y (- h height 2))
+              width height))))
 
 (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)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (truncate (/ (- w width) 2)))
+              (+ y (- h height 2))
+              width height))))
 
 (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)))))
+    (let ((width (min (- w 4) width))
+          (height (min (- h 4) height)))
+      (values (+ x (- w width 2))
+              (+ y (- h height 2))
+              width height))))
 

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

Summary of changes:
 ChangeLog                 |    5 +
 src/clfswm-placement.lisp |  185 +++++++++++++++++++++++++++------------------
 2 files changed, 116 insertions(+), 74 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 20 12:07:06 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 20 May 2012 05:07:06 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-48-g856e6fe
Message-ID: <E1SW4ug-0007nq-IB@common-lisp.net>

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  856e6fea1f2ebf49b763aecd46b970ea1879ff0b (commit)
      from  21b78de6e93ed43a5654746d6037222db575c51f (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 856e6fea1f2ebf49b763aecd46b970ea1879ff0b
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 20 14:06:58 2012 +0200

    TODO update

diff --git a/TODO b/TODO
index 536ce34..fc6a728 100644
--- a/TODO
+++ b/TODO
@@ -14,10 +14,13 @@ FOR THE NEXT RELEASE
 
 - Implement a save/restore root-frame system. And use it on error reset or for undo/redo.
 
-- Add a modeline in contrib/
+- Add a toolbar in contrib/
 
 - Add completion in query input.
 
+- Add a tabbar layout : save some space on top/left... of the frame and display clickable
+    children name.
+
 MAYBE
 =====
 

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

Summary of changes:
 TODO |    5 ++++-
 1 files changed, 4 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 20 12:09:28 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 20 May 2012 05:09:28 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-49-gc974943
Message-ID: <E1SW4wy-0007tk-N9@common-lisp.net>

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  c974943e1b30bd2a931354bbc16491464b19d3a5 (commit)
      from  856e6fea1f2ebf49b763aecd46b970ea1879ff0b (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 c974943e1b30bd2a931354bbc16491464b19d3a5
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 20 14:09:22 2012 +0200

    minor cleanup

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index facf8e4..93b3067 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -593,7 +593,6 @@
     (rec base)))
 
 ;;; Multiple roots support (replace the old *current-root* variable)
-;; TODO: Add find-root-by-coordinates, change-root-geometry
 (let ((root-list nil)
       (current-child nil))
   (defun define-as-root (child x y width height)

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

Summary of changes:
 src/clfswm-internal.lisp |    1 -
 1 files changed, 0 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Sun May 20 12:10:20 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 20 May 2012 05:10:20 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-49-gc974943
Message-ID: <E1SW4xo-0007wL-Ua@common-lisp.net>

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, master has been updated
       via  c974943e1b30bd2a931354bbc16491464b19d3a5 (commit)
       via  856e6fea1f2ebf49b763aecd46b970ea1879ff0b (commit)
       via  21b78de6e93ed43a5654746d6037222db575c51f (commit)
       via  7e8581d49cf750448628d8bebe3db5be96914efb (commit)
       via  0eb8c3465bd8baadeeef7ca426eba63f74e35400 (commit)
       via  32642a72d744e6cca2f6196c9fda1fbc7eee4d5f (commit)
       via  21b53b3f04745a661d8a881bccde644eb1c08065 (commit)
       via  3ae4f173168644e1a9f51ed9140470e2603aae0a (commit)
       via  08028be65be08032cdf474bfa8a4fbbbdaf9715e (commit)
       via  aef0e417c99264a29d4b53ad71765598204cbe13 (commit)
       via  2ba6a3ec1ce3c59ed674a1ff45cb97b9bfa99426 (commit)
       via  d5ebccb678ccfdeb22c419926ef05298f629fc0d (commit)
       via  793638d4c961bf53cbfa04157e6f6655c2b26979 (commit)
      from  bf200cb2092db5bfa72076914fdc9d3a8ceb07c0 (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 -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                      |   34 ++++
 TODO                           |    5 +-
 clfswm.asd                     |   15 +-
 contrib/osd.lisp               |    2 +-
 contrib/server/test.lisp       |    4 +-
 contrib/volume-mode.lisp       |    2 +-
 src/bindings-second-mode.lisp  |   29 ++--
 src/clfswm-circulate-mode.lisp |   65 ++++----
 src/clfswm-expose-mode.lisp    |   60 +++---
 src/clfswm-internal.lisp       |  246 ++++++++++++++-----------
 src/clfswm-layout.lisp         |  104 +++++-----
 src/clfswm-menu.lisp           |   53 +++---
 src/clfswm-nw-hooks.lisp       |   38 ++--
 src/clfswm-pack.lisp           |   64 ++++---
 src/clfswm-placement.lisp      |  224 +++++++++++++++++------
 src/clfswm-query.lisp          |    6 +-
 src/clfswm-util.lisp           |  402 ++++++++++++++++++++++++++--------------
 src/clfswm.lisp                |   19 +-
 src/menu-def.lisp              |    7 +
 src/package.lisp               |   25 ++--
 src/xlib-util.lisp             |    6 -
 21 files changed, 866 insertions(+), 544 deletions(-)


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



From pbrochard at common-lisp.net  Tue May 22 19:49:50 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 22 May 2012 12:49:50 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-51-g97e0c35
Message-ID: <E1SWv5Z-0007r1-RE@common-lisp.net>

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  97e0c3565f478114d3d59634dae227859df7d209 (commit)
       via  7cb5d87eaf9bf65d816dc7b3a543bc7dcbc94aad (commit)
      from  c974943e1b30bd2a931354bbc16491464b19d3a5 (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 97e0c3565f478114d3d59634dae227859df7d209
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue May 22 21:49:42 2012 +0200

    src/clfswm-internal.lisp (place-frames-from-xinerama-infos): Reset root list before calculating new sizes

diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 02129a4..0fe87ac 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -32,6 +32,10 @@
 
 (format t "Loading Toolbar code... ")
 
+(defstruct toolbar root-x root-y direction size thickness placement autohide modules font window gc)
+
+(defparameter *toolbar-list* nil)
+
 ;;; CONFIG - Toolbar window string colors
 (defconfig *toolbar-window-font-string* *default-font-string*
   'Toolbar-Window "Toolbar window font string")
@@ -39,102 +43,114 @@
   'Toolbar-Window "Toolbar Window background color")
 (defconfig *toolbar-window-foreground* "green"
   'Toolbar-Window "Toolbar Window foreground color")
-(defconfig *toolbar-window-border* "red"
+(defconfig *toolbar-window-border* "grey70"
   'Toolbar-Window "Toolbar Window border color")
-(defconfig *toolbar-window-delay* 10
-  'Toolbar-Window "Toolbar Window display delay")
 (defconfig *toolbar-window-transparency* *default-transparency*
   'Toolbar-window "Toolbar window background transparency")
+(defconfig *toolbar-default-thickness* 10
+  'toolbar-window "Toolbar default thickness")
 
 (defconfig *toolbar-window-placement* 'top-left-placement
   'Placement "Toolbar window placement")
 
 
-(let (font
-      window
-      gc
-      width height
-      text
-      current-child)
-  (labels ((text-string (tx)
-	     (typecase tx
-	       (cons (first tx))
-	       (t tx)))
-	   (text-color (tx)
-	     (get-color (typecase tx
-			  (cons (second tx))
-			  (t *toolbar-window-foreground*)))))
-    (defun is-toolbar-window-p (win)
-      (when (and (xlib:window-p win) (xlib:window-p window))
-	(xlib:window-equal win window)))
-
-    (defun refresh-toolbar-window ()
-      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
-      (raise-window window)
-      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
-	(loop for tx in text
-	   for i from 1 do
-	     (setf (xlib:gcontext-foreground gc) (text-color tx))
-	     (xlib:draw-glyphs window gc
-			       (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
-			       (* text-height i 2)
-			       (text-string tx)))))
-
-;;    (defun close-toolbar-window ()
-;;      (erase-timer :refresh-toolbar-window)
-;;      (setf *never-managed-window-list*
-;;	    (remove (list #'is-toolbar-window-p 'raise-window)
-;;		    *never-managed-window-list* :test #'equal))
-;;      (when gc
-;;	(xlib:free-gcontext gc))
-;;      (when window
-;;	(xlib:destroy-window window))
-;;      (when font
-;;	(xlib:close-font font))
-;;      (xlib:display-finish-output *display*)
-;;      (setf window nil
-;;	    gc nil
-;;	    font nil))
-
-    (defun open-toolbar-window (text-list)
-;;      (close-toolbar-window)
-      (setf font (xlib:open-font *display* *toolbar-window-font-string*))
-      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
-	(setf text text-list)
-	(setf width (* (xlib:max-char-width font) (+ (loop for tx in text-list
-							maximize (length (text-string tx))) 2))
-	      height (+ (* text-height (length text-list) 2) text-height))
-	(with-placement (*toolbar-window-placement* x y width height)
-	  (setf window (xlib:create-window :parent *root*
-					   :x x
-					   :y y
-					   :width width
-					   :height height
-					   :background (get-color *toolbar-window-background*)
-					   :border-width *border-size*
-					   :border (get-color *toolbar-window-border*)
-					   :colormap (xlib:screen-default-colormap *screen*)
-					   :event-mask '(:exposure :key-press))
-		gc (xlib:create-gcontext :drawable window
-					 :foreground (get-color *toolbar-window-foreground*)
-					 :background (get-color *toolbar-window-background*)
-					 :font font
-					 :line-style :solid))
-          (setf (window-transparency window) *toolbar-window-transparency*)
-	  (when (frame-p (current-child))
-	    (setf current-child (current-child)))
-          (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
-	  (map-window window)
-	  (refresh-toolbar-window)
-	  (xlib:display-finish-output *display*))))))
-
-
-(defun open-toolbar ()
-  "Open the toolbar mode"
-  (open-toolbar-window '("toto plop")))
-
-
-(add-hook *init-hook* 'open-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-window ()
+  ;;      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
+  ;;      (raise-window window)
+  ;;      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+  ;;	(loop for tx in text
+  ;;	   for i from 1 do
+  ;;	     (setf (xlib:gcontext-foreground gc) (text-color tx))
+  ;;	     (xlib:draw-glyphs window gc
+  ;;			       (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
+  ;;			       (* text-height i 2)
+  ;;			       (text-string tx)))))
+  ;;
+  ;;    (defun close-toolbar-window ()
+  ;;      (erase-timer :refresh-toolbar-window)
+  ;;      (setf *never-managed-window-list*
+  ;;	    (remove (list #'is-toolbar-window-p 'raise-window)
+  ;;		    *never-managed-window-list* :test #'equal))
+  ;;      (when gc
+  ;;	(xlib:free-gcontext gc))
+  ;;      (when window
+  ;;	(xlib:destroy-window window))
+  ;;      (when font
+  ;;	(xlib:close-font font))
+  ;;      (xlib:display-finish-output *display*)
+  ;;      (setf window nil
+  ;;	    gc nil
+  ;;	    font nil))
+
+  (defun open-toolbar (toolbar)
+    (dbg toolbar)
+    (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
+      (when (root-p root)
+        (let ((*get-current-root-fun* (lambda () root)))
+          (setf (toolbar-font toolbar) (xlib:open-font *display* *toolbar-window-font-string*))
+          (let* ((width (if (equal (toolbar-direction toolbar) :horiz)
+                            (round (/ (* (root-w root) (toolbar-size toolbar)) 100))
+                            (toolbar-thickness toolbar)))
+                 (height (if (equal (toolbar-direction toolbar) :horiz)
+                             (toolbar-thickness toolbar)
+                             (round (/ (* (root-h root) (toolbar-size toolbar)) 100)))))
+            (dbg width height)
+            (with-placement ((toolbar-placement toolbar) x y width height)
+              (dbg x y width height)
+              (setf (toolbar-window toolbar) (xlib:create-window :parent *root*
+                                                                 :x x
+                                                                 :y y
+                                                                 :width width
+                                                                 :height height
+                                                                 :background (get-color *toolbar-window-background*)
+                                                                 :border-width *border-size*
+                                                                 :border (get-color *toolbar-window-border*)
+                                                                 :colormap (xlib:screen-default-colormap *screen*)
+                                                                 :event-mask '(:exposure :key-press))
+                    (toolbar-gc toolbar) (xlib:create-gcontext :drawable (toolbar-window toolbar)
+                                                               :foreground (get-color *toolbar-window-foreground*)
+                                                               :background (get-color *toolbar-window-background*)
+                                                               :font (toolbar-font toolbar)
+                                                               :line-style :solid))
+              (push (toolbar-window toolbar) windows-list)
+              (setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
+              (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+              (map-window (toolbar-window toolbar))
+              (raise-window (toolbar-window toolbar))
+              ;;(refresh-toolbar-window)
+              (xlib:display-finish-output *display*))))))))
+
+
+;;(defun open-toolbar (toolbar)
+;;  ;;(open-toolbar-window '("toto plop")))
+;;  (dbg toolbar)
+;;  )
+
+(defun open-all-toolbars ()
+  "Open all toolbars"
+  (dolist (toolbar *toolbar-list*)
+    (open-toolbar toolbar)))
+
+(defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
+  "Add a new toolbar.
+     root-x, root-y: root coordinates
+     direction: one of :horiz or :vert
+     size: toolbar size in percent of root size"
+  (let ((toolbar (make-toolbar :root-x root-x :root-y root-y
+                      :direction direction :size size
+                      :thickness *toolbar-default-thickness*
+                      :placement placement
+                      :autohide autohide
+                      :modules modules)))
+    (push toolbar *toolbar-list*)
+    toolbar))
+
+
+(add-hook *init-hook* 'open-all-toolbars)
 
 
 (format t "done~%")
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 93b3067..b03faf7 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -595,6 +595,10 @@
 ;;; Multiple roots support (replace the old *current-root* variable)
 (let ((root-list nil)
       (current-child nil))
+  (defun reset-root-list ()
+    (setf root-list nil
+          current-child nil))
+
   (defun define-as-root (child x y width height)
     (push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
 
@@ -758,6 +762,7 @@ XINERAMA version 1.1 opcode: 150
   (let ((sizes (get-connected-heads-size))
         (width (xlib:screen-width *screen*))
         (height (xlib:screen-height *screen*)))
+    (reset-root-list)
     ;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
     (if (<= (length sizes) 1)
         (define-as-root *root-frame* (- *border-size*) (- *border-size*) width height)
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 611cf0b..dacf006 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -205,8 +205,11 @@
 ;;;
 ;;; Current root placement
 ;;;
+(defparameter *get-current-root-fun* (lambda ()
+                                       (find-root (current-child))))
+
 (defun current-root-coord ()
-  (let ((root (find-root (current-child))))
+  (let ((root (funcall *get-current-root-fun*)))
     (values (root-x root) (root-y root)
             (root-w root) (root-h root))))
 

commit 7cb5d87eaf9bf65d816dc7b3a543bc7dcbc94aad
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sun May 20 14:32:40 2012 +0200

    Adding a toolbar file

diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
new file mode 100644
index 0000000..02129a4
--- /dev/null
+++ b/contrib/toolbar.lisp
@@ -0,0 +1,140 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Toolbar
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2011 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;;   (load-contrib "toolbar.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading Toolbar code... ")
+
+;;; CONFIG - Toolbar window string colors
+(defconfig *toolbar-window-font-string* *default-font-string*
+  'Toolbar-Window "Toolbar window font string")
+(defconfig *toolbar-window-background* "black"
+  'Toolbar-Window "Toolbar Window background color")
+(defconfig *toolbar-window-foreground* "green"
+  'Toolbar-Window "Toolbar Window foreground color")
+(defconfig *toolbar-window-border* "red"
+  'Toolbar-Window "Toolbar Window border color")
+(defconfig *toolbar-window-delay* 10
+  'Toolbar-Window "Toolbar Window display delay")
+(defconfig *toolbar-window-transparency* *default-transparency*
+  'Toolbar-window "Toolbar window background transparency")
+
+(defconfig *toolbar-window-placement* 'top-left-placement
+  'Placement "Toolbar window placement")
+
+
+(let (font
+      window
+      gc
+      width height
+      text
+      current-child)
+  (labels ((text-string (tx)
+	     (typecase tx
+	       (cons (first tx))
+	       (t tx)))
+	   (text-color (tx)
+	     (get-color (typecase tx
+			  (cons (second tx))
+			  (t *toolbar-window-foreground*)))))
+    (defun is-toolbar-window-p (win)
+      (when (and (xlib:window-p win) (xlib:window-p window))
+	(xlib:window-equal win window)))
+
+    (defun refresh-toolbar-window ()
+      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
+      (raise-window window)
+      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+	(loop for tx in text
+	   for i from 1 do
+	     (setf (xlib:gcontext-foreground gc) (text-color tx))
+	     (xlib:draw-glyphs window gc
+			       (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
+			       (* text-height i 2)
+			       (text-string tx)))))
+
+;;    (defun close-toolbar-window ()
+;;      (erase-timer :refresh-toolbar-window)
+;;      (setf *never-managed-window-list*
+;;	    (remove (list #'is-toolbar-window-p 'raise-window)
+;;		    *never-managed-window-list* :test #'equal))
+;;      (when gc
+;;	(xlib:free-gcontext gc))
+;;      (when window
+;;	(xlib:destroy-window window))
+;;      (when font
+;;	(xlib:close-font font))
+;;      (xlib:display-finish-output *display*)
+;;      (setf window nil
+;;	    gc nil
+;;	    font nil))
+
+    (defun open-toolbar-window (text-list)
+;;      (close-toolbar-window)
+      (setf font (xlib:open-font *display* *toolbar-window-font-string*))
+      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+	(setf text text-list)
+	(setf width (* (xlib:max-char-width font) (+ (loop for tx in text-list
+							maximize (length (text-string tx))) 2))
+	      height (+ (* text-height (length text-list) 2) text-height))
+	(with-placement (*toolbar-window-placement* x y width height)
+	  (setf window (xlib:create-window :parent *root*
+					   :x x
+					   :y y
+					   :width width
+					   :height height
+					   :background (get-color *toolbar-window-background*)
+					   :border-width *border-size*
+					   :border (get-color *toolbar-window-border*)
+					   :colormap (xlib:screen-default-colormap *screen*)
+					   :event-mask '(:exposure :key-press))
+		gc (xlib:create-gcontext :drawable window
+					 :foreground (get-color *toolbar-window-foreground*)
+					 :background (get-color *toolbar-window-background*)
+					 :font font
+					 :line-style :solid))
+          (setf (window-transparency window) *toolbar-window-transparency*)
+	  (when (frame-p (current-child))
+	    (setf current-child (current-child)))
+          (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+	  (map-window window)
+	  (refresh-toolbar-window)
+	  (xlib:display-finish-output *display*))))))
+
+
+(defun open-toolbar ()
+  "Open the toolbar mode"
+  (open-toolbar-window '("toto plop")))
+
+
+(add-hook *init-hook* 'open-toolbar)
+
+
+(format t "done~%")

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

Summary of changes:
 contrib/toolbar.lisp      |  156 +++++++++++++++++++++++++++++++++++++++++++++
 src/clfswm-internal.lisp  |    5 ++
 src/clfswm-placement.lisp |    5 +-
 3 files changed, 165 insertions(+), 1 deletions(-)
 create mode 100644 contrib/toolbar.lisp


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



From pbrochard at common-lisp.net  Tue May 22 19:50:20 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 22 May 2012 12:50:20 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-51-g97e0c35
Message-ID: <E1SWv64-0007sn-Fd@common-lisp.net>

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, master has been updated
       via  97e0c3565f478114d3d59634dae227859df7d209 (commit)
       via  7cb5d87eaf9bf65d816dc7b3a543bc7dcbc94aad (commit)
      from  c974943e1b30bd2a931354bbc16491464b19d3a5 (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 -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 contrib/toolbar.lisp      |  156 +++++++++++++++++++++++++++++++++++++++++++++
 src/clfswm-internal.lisp  |    5 ++
 src/clfswm-placement.lisp |    5 +-
 3 files changed, 165 insertions(+), 1 deletions(-)
 create mode 100644 contrib/toolbar.lisp


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



From pbrochard at common-lisp.net  Tue May 22 20:23:17 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 22 May 2012 13:23:17 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-52-gb66ea99
Message-ID: <E1SWvbx-00013f-Ro@common-lisp.net>

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, master has been updated
       via  b66ea9961ad14c2a937a46639e531eabba430dae (commit)
      from  97e0c3565f478114d3d59634dae227859df7d209 (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 b66ea9961ad14c2a937a46639e531eabba430dae
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue May 22 22:23:12 2012 +0200

    src/clfswm-internal.lisp (place-frames-from-xinerama-infos): Place reset-root-list in the better place init-display

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index b03faf7..61b8d20 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -762,7 +762,6 @@ XINERAMA version 1.1 opcode: 150
   (let ((sizes (get-connected-heads-size))
         (width (xlib:screen-width *screen*))
         (height (xlib:screen-height *screen*)))
-    (reset-root-list)
     ;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
     (if (<= (length sizes) 1)
         (define-as-root *root-frame* (- *border-size*) (- *border-size*) width height)
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index dacf006..e04ac20 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -214,6 +214,8 @@
             (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)
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 2cf7718..c1bb567 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -180,6 +180,7 @@
 
 
 (defun init-display ()
+  (reset-root-list)
   (fill-handle-event-fun-symbols)
   (assoc-keyword-handle-event 'main-mode)
   (setf *screen* (first (xlib:display-roots *display*))

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

Summary of changes:
 src/clfswm-internal.lisp  |    1 -
 src/clfswm-placement.lisp |    2 ++
 src/clfswm.lisp           |    1 +
 3 files changed, 3 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Tue May 22 20:27:56 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 22 May 2012 13:27:56 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-52-gb66ea99
Message-ID: <E1SWvgS-0001Ib-3H@common-lisp.net>

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  b66ea9961ad14c2a937a46639e531eabba430dae (commit)
      from  97e0c3565f478114d3d59634dae227859df7d209 (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 -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 src/clfswm-internal.lisp  |    1 -
 src/clfswm-placement.lisp |    2 ++
 src/clfswm.lisp           |    1 +
 3 files changed, 3 insertions(+), 1 deletions(-)


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



From pbrochard at common-lisp.net  Tue May 22 21:33:47 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 22 May 2012 14:33:47 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-53-g14b6038
Message-ID: <E1SWwiB-0006Qt-Lg@common-lisp.net>

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  14b6038660f7be24eae865a5b7bbdbd54956f960 (commit)
      from  b66ea9961ad14c2a937a46639e531eabba430dae (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 14b6038660f7be24eae865a5b7bbdbd54956f960
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue May 22 23:33:42 2012 +0200

    contrib/toolbar.lisp (toolbar-adjust-root-size): adjust root from toolbar size

diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 0fe87ac..facc63c 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -32,7 +32,7 @@
 
 (format t "Loading Toolbar code... ")
 
-(defstruct toolbar root-x root-y direction size thickness placement autohide modules font window gc)
+(defstruct toolbar root-x root-y root direction size thickness placement autohide modules font window gc)
 
 (defparameter *toolbar-list* nil)
 
@@ -43,7 +43,7 @@
   'Toolbar-Window "Toolbar Window background color")
 (defconfig *toolbar-window-foreground* "green"
   'Toolbar-Window "Toolbar Window foreground color")
-(defconfig *toolbar-window-border* "grey70"
+(defconfig *toolbar-window-border* "red"
   'Toolbar-Window "Toolbar Window border color")
 (defconfig *toolbar-window-transparency* *default-transparency*
   'Toolbar-window "Toolbar window background transparency")
@@ -54,6 +54,25 @@
   'Placement "Toolbar window placement")
 
 
+
+(defun toolbar-adjust-root-size (toolbar)
+  (unless (toolbar-autohide toolbar)
+    (let ((root (toolbar-root toolbar))
+          (placement-name (symbol-name (toolbar-placement toolbar)))
+          (thickness (+ (toolbar-thickness toolbar) (* 2 *border-size*))))
+      (case (toolbar-direction toolbar)
+        (:horiz (cond ((search "TOP" placement-name)
+                       (incf (root-y root) thickness)
+                       (decf (root-h root) thickness))
+                      ((search "BOTTOM" placement-name)
+                       (decf (root-h root) thickness))))
+        (t (cond ((search "LEFT" placement-name)
+                  (incf (root-x root) thickness)
+                  (decf (root-w root) thickness))
+                 ((search "RIGHT" placement-name)
+                  (decf (root-w root) thickness))))))))
+
+
 (let ((windows-list nil))
   (defun is-toolbar-window-p (win)
     (and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal)))
@@ -87,9 +106,9 @@
   ;;	    font nil))
 
   (defun open-toolbar (toolbar)
-    (dbg toolbar)
     (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
       (when (root-p root)
+        (setf (toolbar-root toolbar) root)
         (let ((*get-current-root-fun* (lambda () root)))
           (setf (toolbar-font toolbar) (xlib:open-font *display* *toolbar-window-font-string*))
           (let* ((width (if (equal (toolbar-direction toolbar) :horiz)
@@ -98,9 +117,7 @@
                  (height (if (equal (toolbar-direction toolbar) :horiz)
                              (toolbar-thickness toolbar)
                              (round (/ (* (root-h root) (toolbar-size toolbar)) 100)))))
-            (dbg width height)
             (with-placement ((toolbar-placement toolbar) x y width height)
-              (dbg x y width height)
               (setf (toolbar-window toolbar) (xlib:create-window :parent *root*
                                                                  :x x
                                                                  :y y
@@ -124,16 +141,13 @@
               ;;(refresh-toolbar-window)
               (xlib:display-finish-output *display*))))))))
 
-
-;;(defun open-toolbar (toolbar)
-;;  ;;(open-toolbar-window '("toto plop")))
-;;  (dbg toolbar)
-;;  )
-
 (defun open-all-toolbars ()
   "Open all toolbars"
   (dolist (toolbar *toolbar-list*)
-    (open-toolbar toolbar)))
+    (open-toolbar toolbar))
+  (dolist (toolbar *toolbar-list*)
+    (toolbar-adjust-root-size toolbar)))
+
 
 (defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
   "Add a new toolbar.

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

Summary of changes:
 contrib/toolbar.lisp |   38 ++++++++++++++++++++++++++------------
 1 files changed, 26 insertions(+), 12 deletions(-)


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



From pbrochard at common-lisp.net  Wed May 23 22:12:11 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 23 May 2012 15:12:11 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-54-g0b64c55
Message-ID: <E1SXJmt-00054f-OP@common-lisp.net>

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  0b64c55b92c7212fcc2e25b9efd37dc75f608975 (commit)
      from  14b6038660f7be24eae865a5b7bbdbd54956f960 (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 0b64c55b92c7212fcc2e25b9efd37dc75f608975
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu May 24 00:12:05 2012 +0200

    src/clfswm-internal.lisp (rotate-root-geometry): Do not use rotatef but a simpler algorithm.

diff --git a/ChangeLog b/ChangeLog
index 1aeeb18..2e2cec0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-24  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (rotate-root-geometry): Do not use
+	rotatef but a simpler algorithm.
+
 2012-05-19  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-placement.lisp: Adjust width and height in child and
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index facc63c..3f8c156 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -60,24 +60,26 @@
     (let ((root (toolbar-root toolbar))
           (placement-name (symbol-name (toolbar-placement toolbar)))
           (thickness (+ (toolbar-thickness toolbar) (* 2 *border-size*))))
-      (case (toolbar-direction toolbar)
-        (:horiz (cond ((search "TOP" placement-name)
-                       (incf (root-y root) thickness)
-                       (decf (root-h root) thickness))
-                      ((search "BOTTOM" placement-name)
-                       (decf (root-h root) thickness))))
-        (t (cond ((search "LEFT" placement-name)
-                  (incf (root-x root) thickness)
-                  (decf (root-w root) thickness))
-                 ((search "RIGHT" placement-name)
-                  (decf (root-w root) thickness))))))))
+      (when (root-p root)
+        (case (toolbar-direction toolbar)
+          (:horiz (cond ((search "TOP" placement-name)
+                         (incf (root-y root) thickness)
+                         (decf (root-h root) thickness))
+                        ((search "BOTTOM" placement-name)
+                         (decf (root-h root) thickness))))
+          (t (cond ((search "LEFT" placement-name)
+                    (incf (root-x root) thickness)
+                    (decf (root-w root) thickness))
+                   ((search "RIGHT" placement-name)
+                    (decf (root-w root) thickness)))))))))
 
 
 (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-window ()
+  (defun refresh-toolbar (toolbar)
+    (dbg (toolbar-modules toolbar)))
   ;;      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
   ;;      (raise-window window)
   ;;      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
@@ -89,21 +91,21 @@
   ;;			       (* text-height i 2)
   ;;			       (text-string tx)))))
   ;;
-  ;;    (defun close-toolbar-window ()
-  ;;      (erase-timer :refresh-toolbar-window)
-  ;;      (setf *never-managed-window-list*
-  ;;	    (remove (list #'is-toolbar-window-p 'raise-window)
-  ;;		    *never-managed-window-list* :test #'equal))
-  ;;      (when gc
-  ;;	(xlib:free-gcontext gc))
-  ;;      (when window
-  ;;	(xlib:destroy-window window))
-  ;;      (when font
-  ;;	(xlib:close-font font))
-  ;;      (xlib:display-finish-output *display*)
-  ;;      (setf window nil
-  ;;	    gc nil
-  ;;	    font nil))
+    (defun close-toolbar (toolbar)
+      (erase-timer :refresh-toolbar-window)
+      (setf *never-managed-window-list*
+	    (remove (list #'is-toolbar-window-p nil)
+		    *never-managed-window-list* :test #'equal))
+      (awhen (toolbar-gc toolbar)
+	(xlib:free-gcontext it))
+      (awhen (toolbar-window toolbar)
+	(xlib:destroy-window it))
+      (awhen (toolbar-font toolbar)
+	(xlib:close-font it))
+      (xlib:display-finish-output *display*)
+      (setf (toolbar-window toolbar) nil
+	    (toolbar-gc toolbar) nil
+            (toolbar-font toolbar) nil))
 
   (defun open-toolbar (toolbar)
     (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
@@ -135,10 +137,10 @@
                                                                :line-style :solid))
               (push (toolbar-window toolbar) windows-list)
               (setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
-              (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+              (push (list #'is-toolbar-window-p nil) *never-managed-window-list*)
               (map-window (toolbar-window toolbar))
               (raise-window (toolbar-window toolbar))
-              ;;(refresh-toolbar-window)
+              (refresh-toolbar toolbar)
               (xlib:display-finish-output *display*))))))))
 
 (defun open-all-toolbars ()
@@ -148,6 +150,10 @@
   (dolist (toolbar *toolbar-list*)
     (toolbar-adjust-root-size toolbar)))
 
+(defun close-all-toolbars ()
+  (dolist (toolbar *toolbar-list*)
+    (close-toolbar toolbar)))
+
 
 (defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
   "Add a new toolbar.
@@ -165,6 +171,7 @@
 
 
 (add-hook *init-hook* 'open-all-toolbars)
+(add-hook *close-hook* 'close-all-toolbars)
 
 
 (format t "done~%")
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 61b8d20..2606087 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -652,20 +652,22 @@
       (rotatef (root-h root-1) (root-h root-2))))
 
   (defun rotate-root-geometry ()
-    (let* ((first (first root-list))
-           (len (length root-list))
-           (orig-x (root-x first))
-           (orig-y (root-y first))
-           (orig-w (root-w first))
-           (orig-h (root-h first)))
-      (dotimes (i (1- len))
-        (exchange-root-geometry (nth i root-list) (nth (1+ i) root-list)))
-      (let ((root-1 (nth (1- len) root-list)))
-        (setf (root-x root-1) orig-x)
-        (setf (root-y root-1) orig-y)
-        (setf (root-w root-1) orig-w)
-        (setf (root-h root-1) orig-h))))
-
+    (let* ((current (first root-list))
+           (orig-x (root-x current))
+           (orig-y (root-y current))
+           (orig-w (root-w current))
+           (orig-h (root-h current)))
+      (dolist (elem (rest root-list))
+        (setf (root-x current) (root-x elem)
+              (root-y current) (root-y elem)
+              (root-w current) (root-w elem)
+              (root-h current) (root-h elem)
+              current elem))
+      (let ((last (car (last root-list))))
+        (setf (root-x last) orig-x
+              (root-y last) orig-y
+              (root-w last) orig-w
+              (root-h last) orig-h))))
 
   (defun anti-rotate-root-geometry ()
     (setf root-list (nreverse root-list))
@@ -1201,7 +1203,7 @@ XINERAMA version 1.1 opcode: 150
 (defun set-current-root (child parent window-parent)
   "Set current root if parent is not in current root"
   (let ((root (find-root child)))
-    (when (and window-parent
+    (when (and root window-parent
                (not (child-root-p child))
                (not (find-child parent (root-child root))))
       (change-root root parent)
@@ -1239,7 +1241,7 @@ For window: set current child to window or its parent according to window-parent
 (defun enter-frame ()
   "Enter in the selected frame - ie make it the root frame"
   (let ((root (find-root (current-child))))
-    (unless (child-equal-p (root-child root) (current-child))
+    (when (and root (not (child-equal-p (root-child root) (current-child))))
       (change-root root (current-child)))
     (show-all-children t)))
 
@@ -1305,17 +1307,19 @@ For window: set current child to window or its parent according to window-parent
 (defun switch-to-root-frame (&key (show-later nil))
   "Switch to the root frame"
   (let ((root (find-root (current-child))))
-    (change-root root (root-original root)))
-  (unless show-later
-    (show-all-children t)))
+    (when root
+      (change-root root (root-original root)))
+    (unless show-later
+      (show-all-children t))))
 
 (defun switch-and-select-root-frame (&key (show-later nil))
   "Switch and select the root frame"
   (let ((root (find-root (current-child))))
-    (change-root root (root-original root))
-    (setf (current-child) (root-original root)))
-  (unless show-later
-    (show-all-children t)))
+    (when root
+      (change-root root (root-original root))
+      (setf (current-child) (root-original root)))
+    (unless show-later
+      (show-all-children t))))
 
 
 (defun toggle-show-root-frame ()
@@ -1333,7 +1337,8 @@ For window: set current child to window or its parent according to window-parent
         (awhen (child-root-p child)
           (change-root it (find-parent-frame child)))
         (when (child-equal-p child (current-child))
-          (setf (current-child) (root-child (find-root child))))
+          (awhen (find-root child)
+            (setf (current-child) (root-child it))))
         t)))
 
 

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

Summary of changes:
 ChangeLog                |    5 +++
 contrib/toolbar.lisp     |   65 +++++++++++++++++++++++++--------------------
 src/clfswm-internal.lisp |   53 ++++++++++++++++++++-----------------
 3 files changed, 70 insertions(+), 53 deletions(-)


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



From pbrochard at common-lisp.net  Wed May 23 22:15:03 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 23 May 2012 15:15:03 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-54-g0b64c55
Message-ID: <E1SXJpf-00061d-3f@common-lisp.net>

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, master has been updated
       via  0b64c55b92c7212fcc2e25b9efd37dc75f608975 (commit)
       via  14b6038660f7be24eae865a5b7bbdbd54956f960 (commit)
      from  b66ea9961ad14c2a937a46639e531eabba430dae (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 -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                |    5 +++
 contrib/toolbar.lisp     |   81 +++++++++++++++++++++++++++++-----------------
 src/clfswm-internal.lisp |   53 ++++++++++++++++-------------
 3 files changed, 85 insertions(+), 54 deletions(-)


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



From pbrochard at common-lisp.net  Mon May 28 21:47:55 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Mon, 28 May 2012 14:47:55 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-55-g6f96f0d
Message-ID: <E1SZ7n9-0004eV-Ir@common-lisp.net>

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  6f96f0da9f45ee751c3fd7e4d4ad5c687d3eeb22 (commit)
      from  0b64c55b92c7212fcc2e25b9efd37dc75f608975 (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 6f96f0da9f45ee751c3fd7e4d4ad5c687d3eeb22
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Mon May 28 23:47:47 2012 +0200

    contrib/toolbar.lisp: begining of toolbar support.

diff --git a/ChangeLog b/ChangeLog
index 2e2cec0..5b90db3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/toolbar.lisp: begining of toolbar support.
+
 2012-05-24  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (rotate-root-geometry): Do not use
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 3f8c156..a5a5b30 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -35,6 +35,7 @@
 (defstruct toolbar root-x root-y root direction size thickness placement autohide modules font window gc)
 
 (defparameter *toolbar-list* nil)
+(defparameter *toolbar-module-list* nil)
 
 ;;; CONFIG - Toolbar window string colors
 (defconfig *toolbar-window-font-string* *default-font-string*
@@ -47,13 +48,14 @@
   'Toolbar-Window "Toolbar Window border color")
 (defconfig *toolbar-window-transparency* *default-transparency*
   'Toolbar-window "Toolbar window background transparency")
-(defconfig *toolbar-default-thickness* 10
+(defconfig *toolbar-default-thickness* 20
   'toolbar-window "Toolbar default thickness")
 
 (defconfig *toolbar-window-placement* 'top-left-placement
   'Placement "Toolbar window placement")
 
-
+(defun toolbar-symbol-fun (name)
+  (create-symbol 'toolbar- name '-module))
 
 (defun toolbar-adjust-root-size (toolbar)
   (unless (toolbar-autohide toolbar)
@@ -74,38 +76,64 @@
                     (decf (root-w root) thickness)))))))))
 
 
+(defun toolbar-draw-text (toolbar pos1 pos2 text)
+  "pos1: percent, pos2: pixels"
+  (labels ((horiz-text ()
+             (let* ((height (- (xlib:font-ascent (toolbar-font toolbar)) (xlib:font-descent (toolbar-font toolbar))))
+                    (dy (truncate (+ pos2 (/ height 2))))
+                    (width (xlib:text-width (toolbar-font toolbar) text))
+                    (pos (truncate (/ (* (- (xlib:drawable-width (toolbar-window toolbar)) width) pos1) 100))))
+               (xlib:draw-glyphs *pixmap-buffer* (toolbar-gc toolbar) pos dy text)))
+           (vert-text ()
+             (let* ((width (xlib:max-char-width (toolbar-font toolbar)))
+                    (dx (truncate (- pos2 (/ width 2))))
+                    (dpos (xlib:max-char-ascent (toolbar-font toolbar)))
+                    (height (* dpos (length text)))
+                    (pos (+ (truncate (/ (* (- (xlib:drawable-height (toolbar-window toolbar)) height
+                                               (xlib:max-char-descent (toolbar-font toolbar)))
+                                            pos1) 100))
+                            (xlib:font-ascent (toolbar-font toolbar)))))
+               (loop for c across text
+                  do (xlib:draw-glyphs *pixmap-buffer* (toolbar-gc toolbar) dx pos (string c))
+                    (incf pos dpos)))))
+    (case (toolbar-direction toolbar)
+      (:horiz (horiz-text))
+      (:vert (vert-text)))))
+
+
 (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)
-    (dbg (toolbar-modules toolbar)))
-  ;;      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
-  ;;      (raise-window window)
-  ;;      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
-  ;;	(loop for tx in text
-  ;;	   for i from 1 do
-  ;;	     (setf (xlib:gcontext-foreground gc) (text-color tx))
-  ;;	     (xlib:draw-glyphs window gc
-  ;;			       (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
-  ;;			       (* text-height i 2)
-  ;;			       (text-string tx)))))
-  ;;
-    (defun close-toolbar (toolbar)
-      (erase-timer :refresh-toolbar-window)
-      (setf *never-managed-window-list*
-	    (remove (list #'is-toolbar-window-p nil)
-		    *never-managed-window-list* :test #'equal))
-      (awhen (toolbar-gc toolbar)
-	(xlib:free-gcontext it))
-      (awhen (toolbar-window toolbar)
-	(xlib:destroy-window it))
-      (awhen (toolbar-font toolbar)
-	(xlib:close-font it))
-      (xlib:display-finish-output *display*)
-      (setf (toolbar-window toolbar) nil
-	    (toolbar-gc toolbar) nil
-            (toolbar-font toolbar) nil))
+    (add-timer 1 (lambda ()
+                   (refresh-toolbar toolbar))
+               :refresh-toolbar)
+    (clear-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar))
+;;    (toolbar-draw-text toolbar 0 (/ *toolbar-default-thickness* 2) "This is a test!!! abcpdj")
+;;    (toolbar-draw-text toolbar 100 (/ *toolbar-default-thickness* 2) "This ijTjjs a test!!! abcpdj")
+    ;;    (dbg (toolbar-modules 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*
+          (remove (list #'is-toolbar-window-p nil)
+                  *never-managed-window-list* :test #'equal))
+    (awhen (toolbar-gc toolbar)
+      (xlib:free-gcontext it))
+    (awhen (toolbar-window toolbar)
+      (xlib:destroy-window it))
+    (awhen (toolbar-font toolbar)
+      (xlib:close-font it))
+    (xlib:display-finish-output *display*)
+    (setf (toolbar-window toolbar) nil
+          (toolbar-gc toolbar) nil
+          (toolbar-font toolbar) nil))
 
   (defun open-toolbar (toolbar)
     (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
@@ -174,4 +202,25 @@
 (add-hook *close-hook* 'close-all-toolbars)
 
 
+(defmacro define-toolbar-module ((name) &body body)
+  (let ((symbol-fun (toolbar-symbol-fun name)))
+    `(progn
+       (pushnew ',name *toolbar-module-list*)
+       (defun ,symbol-fun (toolbar module)
+         , at body))))
+
+
+
+(define-toolbar-module (clock)
+  "The clock module"
+  (toolbar-draw-text toolbar (second module) (/ *toolbar-default-thickness* 2)
+                     "Clock"))
+
+
+(define-toolbar-module (label)
+  "The label module"
+  (toolbar-draw-text toolbar (second module) (/ *toolbar-default-thickness* 2)
+                     "Label"))
+
+
 (format t "done~%")

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

Summary of changes:
 ChangeLog            |    4 ++
 contrib/toolbar.lisp |  107 ++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 82 insertions(+), 29 deletions(-)


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



From pbrochard at common-lisp.net  Wed May 30 20:49:24 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 30 May 2012 13:49:24 -0700
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch test updated. R-1106-56-g0ff435c
Message-ID: <E1SZppc-00026e-BV@common-lisp.net>

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  0ff435ca00f6ab1f2e434087dfa38048a1527808 (commit)
      from  6f96f0da9f45ee751c3fd7e4d4ad5c687d3eeb22 (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 0ff435ca00f6ab1f2e434087dfa38048a1527808
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed May 30 22:49:15 2012 +0200

    contrib/toolbar.lisp (clock): Add a clock module.

diff --git a/ChangeLog b/ChangeLog
index 5b90db3..1cf1374 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-05-30  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/toolbar.lisp (clock): Add a clock module.
+
 2012-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/toolbar.lisp: begining of toolbar support.
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index a5a5b30..17205b3 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -154,7 +154,7 @@
                                                                  :width width
                                                                  :height height
                                                                  :background (get-color *toolbar-window-background*)
-                                                                 :border-width *border-size*
+                                                                 :border-width 0
                                                                  :border (get-color *toolbar-window-border*)
                                                                  :colormap (xlib:screen-default-colormap *screen*)
                                                                  :event-mask '(:exposure :key-press))
@@ -213,8 +213,11 @@
 
 (define-toolbar-module (clock)
   "The clock module"
-  (toolbar-draw-text toolbar (second module) (/ *toolbar-default-thickness* 2)
-                     "Clock"))
+  (multiple-value-bind (s m h)
+      (get-decoded-time)
+    (declare (ignore s))
+    (toolbar-draw-text toolbar (second module) (/ *toolbar-default-thickness* 2)
+                       (format nil "~A:~A" h m))))
 
 
 (define-toolbar-module (label)
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index c1bb567..51a44ed 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -134,6 +134,9 @@
   (awhen (find-frame-window window)
     (display-frame-info it)))
 
+(define-handler main-mode :resize-request (window)
+  (dbg :resize-request window))
+
 
 (defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys)
   "Handle X errors"
@@ -204,6 +207,7 @@
   (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
 							      :substructure-notify
 							      :property-change
+                                                              :resize-redirect
 							      :exposure
 							      :button-press
 							      :button-release

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

Summary of changes:
 ChangeLog            |    4 ++++
 contrib/toolbar.lisp |    9 ++++++---
 src/clfswm.lisp      |    4 ++++
 3 files changed, 14 insertions(+), 3 deletions(-)


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