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

[Philippe Brochard]

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  02e0f7b49c2d606348acb8008f47c59c87109048 (commit)
      from  e9afcbc29bc68c2939eaf4b852a86558f3d9c669 (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 02e0f7b49c2d606348acb8008f47c59c87109048
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Mon Jun 18 22:46:52 2012 +0200

    src/clfswm-placement.lisp: Take care of current child border size instead of placed window border size

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index af41d01..75b479a 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -36,6 +36,7 @@
   (x-drawable-border-width child))
 
 (defmethod child-border-size (child)
+  (declare (ignore child))
   0)
 
 (defgeneric set-child-border-size (child value))
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 4e8d4e9..81d49bd 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -120,15 +120,18 @@
     (xlib:window (values (x-drawable-x (current-child))
 			 (x-drawable-y (current-child))
 			 (- (x-drawable-width (current-child)) (* 2 border-size))
-			 (- (x-drawable-height (current-child)) (* 2 border-size))))
+			 (- (x-drawable-height (current-child)) (* 2 border-size))
+                         (x-drawable-border-width (current-child))))
     (frame (values (frame-rx (current-child))
 		   (frame-ry (current-child))
 		   (- (frame-rw (current-child)) (* 2 border-size))
-		   (- (frame-rh (current-child)) (* 2 border-size))))
-    (t (values 0 0 10 10))))
+		   (- (frame-rh (current-child)) (* 2 border-size))
+                   (x-drawable-border-width (frame-window (current-child)))))
+    (t (values 0 0 10 10 1))))
 
-(defmacro with-current-child-coord ((border-size x y w h) &body body)
-  `(multiple-value-bind (,x ,y ,w ,h)
+(defmacro with-current-child-coord ((border-size x y w h bds) &body body)
+  "Bind x y w h bds to current child coordinates and border size"
+  `(multiple-value-bind (,x ,y ,w ,h ,bds)
        (current-child-coord ,border-size)
      (let ((width (min w width))
            (height (min h height)))
@@ -136,47 +139,45 @@
 
 
 (defun top-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x border-size) (+ y border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x bds) (+ y bds) width height)))
 
 (defun top-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (truncate (/ (- w width) 2)) border-size) (+ y border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (truncate (/ (- w width) 2)) bds) (+ y bds) width height)))
 
 (defun top-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (- w width) border-size) (+ y border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (- w width) bds) (+ y bds) width height)))
 
 
 
 (defun middle-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x border-size) (+ y (truncate (/ (- h height) 2)) border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x bds) (+ y (truncate (/ (- h height) 2)) bds) width height)))
 
 (defun middle-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (truncate (/ (- w width) 2)) border-size)
-            (+ y (truncate (/ (- h height) 2)) border-size)
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (truncate (/ (- w width) 2)) bds) (+ y (truncate (/ (- h height) 2)) bds)
             width height)))
 
 (defun middle-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (- w width) border-size)
-            (+ y (truncate (/ (- h height) 2)) border-size)
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (- w width) bds) (+ y (truncate (/ (- h height) 2)) bds)
             width height)))
 
 
 (defun bottom-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x border-size) (+ y (- h height) border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x bds) (+ y (- h height) bds) width height)))
 
 (defun bottom-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (truncate (/ (- w width) 2)) border-size) (+ y (- h height) border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (truncate (/ (- w width) 2)) bds) (+ y (- h height) bds) width height)))
 
 (defun bottom-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*))
-  (with-current-child-coord (border-size x y w h)
-    (values (+ x (- w width) border-size) (+ y (- h height) border-size) width height)))
+  (with-current-child-coord (border-size x y w h bds)
+    (values (+ x (- w width) bds) (+ y (- h height) bds) width height)))
 
 
 ;;;
@@ -240,8 +241,8 @@
     (values (+ x (- w width)) (+ y (- h height)) width height)))
 
 
-;;;;; Some tests
-;;(defun test-some-placement (placement)
-;;  (setf *second-mode-placement* placement
-;;        *query-mode-placement* placement))
+;;; Some tests
+(defun test-some-placement (placement)
+  (setf *second-mode-placement* placement
+        *query-mode-placement* placement))
 

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

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


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