[clfswm-cvs] r378 - clfswm/src

[Philippe Brochard]

Author: pbrochard
Date: Mon Nov  8 18:07:42 2010
New Revision: 378

Log:
src/clfswm-layout.lisp (tile-layout, set-tile-layout): Fill blanks if needed.

Modified:
   clfswm/src/clfswm-layout.lisp

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Mon Nov  8 18:07:42 2010
@@ -188,7 +188,7 @@
 ;;; Tile layout
 (defun tile-layout-ask-keep-position ()
   (when (frame-p *current-child*)
-    (let ((keep-position (query-string "Keep child positions?" "" '("yes" "no"))))
+    (let ((keep-position (query-string "Keep frame children positions?" "" '("yes" "no"))))
       (if (or (string= keep-position "")
 	      (char= (char keep-position 0) #\y)
 	      (char= (char keep-position 0) #\Y))
@@ -228,12 +228,19 @@
   (let* ((managed-children (update-layout-managed-children child parent))
 	 (pos (child-position child managed-children))
 	 (len (length managed-children))
-	 (n (ceiling (sqrt len)))
-	 (dx (/ (frame-rw parent) n))
-	 (dy (/ (frame-rh parent) (ceiling (/ len n)))))
-    (values (round (+ (frame-rx parent) (truncate (* (mod pos n) dx)) 1))
-	    (round (+ (frame-ry parent) (truncate (* (truncate (/ pos n)) dy)) 1))
-	    (round (- dx 2))
+	 (nx (ceiling (sqrt len)))
+	 (ny  (ceiling (/ len nx)))
+	 (dx (/ (frame-rw parent) nx))
+	 (dy (/ (frame-rh parent) ny))
+	 (dpos (- (* nx ny) len))
+	 (width dx))
+    (when (plusp dpos)
+      (if (zerop pos)
+	  (setf width (* dx (1+ dpos)))
+	  (incf pos dpos)))
+    (values (round (+ (frame-rx parent) (truncate (* (mod pos nx) dx)) 1))
+	    (round (+ (frame-ry parent) (truncate (* (truncate (/ pos nx)) dy)) 1))
+	    (round (- width 2))
 	    (round (- dy 2)))))
 
 (defun set-tile-layout ()
@@ -251,13 +258,20 @@
   (let* ((managed-children (update-layout-managed-children child parent))
 	 (pos (child-position child managed-children))
 	 (len (length managed-children))
-	 (n (ceiling (sqrt len)))
-	 (dx (/ (frame-rw parent) (ceiling (/ len n))))
-	 (dy (/ (frame-rh parent) n)))
-    (values (round (+ (frame-rx parent) (truncate (* (truncate (/ pos n)) dx)) 1))
-	    (round (+ (frame-ry parent) (truncate (* (mod pos n) dy)) 1))
+	 (ny (ceiling (sqrt len)))
+	 (nx (ceiling (/ len ny)))
+	 (dx (/ (frame-rw parent) nx))
+	 (dy (/ (frame-rh parent) ny))
+	 (dpos (- (* nx ny) len))
+	 (height dy))
+    (when (plusp dpos)
+      (if (zerop pos)
+	  (setf height (* dy (1+ dpos)))
+	  (incf pos dpos)))
+    (values (round (+ (frame-rx parent) (truncate (* (truncate (/ pos ny)) dx)) 1))
+	    (round (+ (frame-ry parent) (truncate (* (mod pos ny) dy)) 1))
 	    (round (- dx 2))
-	    (round (- dy 2)))))
+	    (round (- height 2)))))
 
 (defun set-tile-horizontal-layout ()
   "Tile child in its frame (horizontal)"