[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-35-g9ef2d64
Philippe Brochard
pbrochard at common-lisp.net
Sun May 6 21:52:19 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 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
More information about the clfswm-cvs
mailing list