[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-151-g7d8bfb3
Philippe Brochard
pbrochard at common-lisp.net
Sat Nov 10 22:14:34 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, master has been updated
via 7d8bfb3fc2043af504da914bb61f6b9158162fc6 (commit)
from 482c7b3303101e2bc62d142c38045814e66e6b00 (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 7d8bfb3fc2043af504da914bb61f6b9158162fc6
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sat Nov 10 23:14:27 2012 +0100
Change root structure on screen size change only when there is some heads changes
diff --git a/contrib/wallpaper.lisp b/contrib/wallpaper.lisp
index 8ffa75f..42017ed 100644
--- a/contrib/wallpaper.lisp
+++ b/contrib/wallpaper.lisp
@@ -67,7 +67,7 @@
(setf ind (if (< ind len) (1+ ind) 0))))
(format str "~A" filename))))
(format t "~A~%" command)
- (do-shell-output command)))
+ (do-shell-output "~A" command)))
(defun create-wallpaper (filename &rest images)
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index f2ca58c..9588f8b 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -842,38 +842,53 @@ XINERAMA version 1.1 opcode: 150
;;'((10 10 500 580) (540 50 470 500))))))
-(defun place-frames-from-xinerama-infos ()
- "Place frames according to xdpyinfo/xinerama informations"
- (reset-root-list)
- (let ((sizes (get-connected-heads-size))
- (width (xlib:screen-width *screen*))
- (height (xlib:screen-height *screen*)))
- (format t "Screen sizes: ~A~%" sizes)
- ;; Add frames in *root-frame* until we get the same number as screen heads
- (loop while (< (length (frame-child *root-frame*)) (length sizes))
- do (let ((frame (create-frame)))
- (add-frame frame *root-frame*)))
- ;; On the opposite way: remove frames until there is more than screen heads in *root-frame*
- (when (and sizes (> (length (frame-child *root-frame*)) (length sizes)))
- (dotimes (i (- (length (frame-child *root-frame*)) (length sizes)))
- (let ((deleted-child (pop (frame-child *root-frame*))))
- (typecase deleted-child
- (xlib:window (push deleted-child (frame-child (first (frame-child *root-frame*)))))
- (frame (dolist (child (frame-child deleted-child))
- (push child (frame-child (first (frame-child *root-frame*)))))))
- (setf (frame-layout (first (frame-child *root-frame*))) 'tile-space-layout
- (frame-data-slot (first (frame-child *root-frame*)) :tile-layout-keep-position) :yes))))
- (loop for size in sizes
- for frame in (frame-child *root-frame*)
- do (destructuring-bind (x y w h) size
- (setf (frame-x frame) (float (/ x width))
- (frame-y frame) (float (/ y height))
- (frame-w frame) (float (/ w width))
- (frame-h frame) (float (/ h height)))
- ;;(add-placed-frame-tmp frame 2) ;; For tests
- (unless (frame-child frame)
- (add-frame (create-frame) frame))
- (define-as-root frame x y w h)))))
+(let ((last-sizes nil))
+ (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*)))
+ (labels ((update-root-geometry ()
+ (loop for size in sizes
+ for root in (get-root-list)
+ do (destructuring-bind (x y w h) size
+ (setf (root-x root) x
+ (root-y root) y
+ (root-w root) w
+ (root-h root) h))))
+ (create-root-geometry ()
+ (reset-root-list)
+ ;; Add frames in *root-frame* until we get the same number as screen heads
+ (loop while (< (length (frame-child *root-frame*)) (length sizes))
+ do (let ((frame (create-frame)))
+ (add-frame frame *root-frame*)))
+ ;; On the opposite way: remove frames while there is more than screen heads in *root-frame*
+ (when (and sizes (> (length (frame-child *root-frame*)) (length sizes)))
+ (dotimes (i (- (length (frame-child *root-frame*)) (length sizes)))
+ (let ((deleted-child (pop (frame-child *root-frame*))))
+ (typecase deleted-child
+ (xlib:window (push deleted-child (frame-child (first (frame-child *root-frame*)))))
+ (frame (dolist (child (frame-child deleted-child))
+ (push child (frame-child (first (frame-child *root-frame*)))))))
+ (setf (frame-layout (first (frame-child *root-frame*))) 'tile-space-layout
+ (frame-data-slot (first (frame-child *root-frame*)) :tile-layout-keep-position) :yes))))
+ (loop for size in sizes
+ for frame in (frame-child *root-frame*)
+ do (destructuring-bind (x y w h) size
+ (setf (frame-x frame) (float (/ x width))
+ (frame-y frame) (float (/ y height))
+ (frame-w frame) (float (/ w width))
+ (frame-h frame) (float (/ h height)))
+ ;;(add-placed-frame-tmp frame 2) ;; For tests
+ (unless (frame-child frame)
+ (add-frame (create-frame) frame))
+ (define-as-root frame x y w h)))))
+ (format t "Screen sizes: ~A~%" sizes)
+ (if (= (length sizes) (length last-sizes))
+ (update-root-geometry)
+ (create-root-geometry))
+ (setf last-sizes sizes)))))
+
(defun finish-configuring-root ()
-----------------------------------------------------------------------
Summary of changes:
contrib/wallpaper.lisp | 2 +-
src/clfswm-internal.lisp | 79 +++++++++++++++++++++++++++------------------
2 files changed, 48 insertions(+), 33 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list