[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-47-g21b78de
Philippe Brochard
pbrochard at common-lisp.net
Sat May 19 20:19:29 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".
The branch, test has been updated
via 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
More information about the clfswm-cvs
mailing list