[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-42-g3ae4f17
Philippe Brochard
pbrochard at common-lisp.net
Wed May 16 22:14:45 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 3ae4f173168644e1a9f51ed9140470e2603aae0a (commit)
from 08028be65be08032cdf474bfa8a4fbbbdaf9715e (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 3ae4f173168644e1a9f51ed9140470e2603aae0a
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Thu May 17 00:14:38 2012 +0200
src/clfswm-util.lisp (exchange-root-geometry-with-mouse): New function and menu.
diff --git a/ChangeLog b/ChangeLog
index 127e19c..2c24f0c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-17 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (exchange-root-geometry-with-mouse): New
+ function and menu.
+
2012-05-16 Philippe Brochard <pbrochard at common-lisp.net>
* src/menu-def.lisp: New root menu.
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index ec9d293..e9387c3 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -57,7 +57,7 @@
(defun open-root-menu ()
"Open the root menu"
- (open-menu (find-menu 'root-menu) nil t))
+ (open-menu (find-menu 'root-menu)))
(defun open-child-menu ()
"Open the child menu"
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 3ec2d95..2771d7e 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -381,40 +381,3 @@
(middle-child-x child) (child-y2 child))))))
-
-
-(defun select-generic-root (fun)
- (no-focus)
- (let* ((current-root (find-root (current-child)))
- (parent (find-parent-frame (root-original current-root))))
- (setf (frame-child parent) (funcall fun (frame-child parent)))
- (let ((new-root (find-root (frame-selected-child parent))))
- (setf (current-child) (aif (root-current-child new-root)
- it
- (frame-selected-child parent)))))
- (show-all-children t)
- (leave-second-mode))
-
-(defun select-next-root ()
- "Select the next root"
- (select-generic-root #'rotate-list))
-
-(defun select-previous-root ()
- "Select the previous root"
- (select-generic-root #'anti-rotate-list))
-
-
-(defun rotate-root-geometry-generic (fun)
- (no-focus)
- (funcall fun)
- (show-all-children t)
- (leave-second-mode))
-
-
-(defun rotate-root-geometry-next ()
- "Rotate root geometry to next root"
- (rotate-root-geometry-generic #'rotate-root-geometry))
-
-(defun rotate-root-geometry-previous ()
- "Rotate root geometry to previous root"
- (rotate-root-geometry-generic #'anti-rotate-root-geometry))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 26bf269..440321a 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -641,6 +641,12 @@
(defun find-current-root ()
(root-child (find-root (current-child))))
+ (defun exchange-root-geometry (root-1 root-2)
+ (rotatef (root-x root-1) (root-x root-2))
+ (rotatef (root-y root-1) (root-y root-2))
+ (rotatef (root-w root-1) (root-w root-2))
+ (rotatef (root-h root-1) (root-h root-2)))
+
(defun rotate-root-geometry ()
(let* ((first (first root-list))
(len (length root-list))
@@ -649,12 +655,7 @@
(orig-w (root-w first))
(orig-h (root-h first)))
(dotimes (i (1- len))
- (let ((root-1 (nth i root-list))
- (root-2 (nth (1+ i) root-list)))
- (rotatef (root-x root-1) (root-x root-2))
- (rotatef (root-y root-1) (root-y root-2))
- (rotatef (root-w root-1) (root-w root-2))
- (rotatef (root-h root-1) (root-h root-2))))
+ (exchange-root-geometry (nth i root-list) (nth (1+ i) root-list)))
(let ((root-1 (nth (1- len) root-list)))
(setf (root-x root-1) orig-x)
(setf (root-y root-1) orig-y)
@@ -662,12 +663,12 @@
(setf (root-h root-1) orig-h))))
-
(defun anti-rotate-root-geometry ()
(setf root-list (nreverse root-list))
(rotate-root-geometry)
(setf root-list (nreverse root-list)))
+ ;;; Current child functions
(defun current-child ()
current-child)
diff --git a/src/clfswm-menu.lisp b/src/clfswm-menu.lisp
index a629eed..3574773 100644
--- a/src/clfswm-menu.lisp
+++ b/src/clfswm-menu.lisp
@@ -137,7 +137,7 @@
(funcall action)))))
-(defun open-menu (&optional (menu *menu*) (parent nil) (restart-menu nil))
+(defun open-menu (&optional (menu *menu*) (parent nil))
"Open the main menu"
(when menu
(let ((action nil)
@@ -165,9 +165,6 @@
(when selected-item
(awhen (nth selected-item (menu-item menu))
(setf action (menu-item-value it)))))
- (let ((*in-second-mode* (if restart-menu nil *in-second-mode*)))
- (open-menu-do-action action menu parent))
- (when (and action restart-menu)
- (open-menu menu parent restart-menu))))))
+ (open-menu-do-action action menu parent)))))
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 8bc4c62..88c4594 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1722,3 +1722,81 @@ For window: set current child to window or its parent according to window-parent
(defun anti-rotate-frame-geometry ()
"Anti rotate brother frame geometry"
(rotate-frame-geometry-generic #'reverse))
+
+
+;;; Root functions utility
+(defun select-generic-root (fun restart-menu)
+ (no-focus)
+ (let* ((current-root (find-root (current-child)))
+ (parent (find-parent-frame (root-original current-root))))
+ (setf (frame-child parent) (funcall fun (frame-child parent)))
+ (let ((new-root (find-root (frame-selected-child parent))))
+ (setf (current-child) (aif (root-current-child new-root)
+ it
+ (frame-selected-child parent)))))
+ (show-all-children t)
+ (if restart-menu
+ (open-menu (find-menu 'root-menu))
+ (leave-second-mode)))
+
+(defun select-next-root ()
+ "Select the next root"
+ (select-generic-root #'rotate-list nil))
+
+(defun select-previous-root ()
+ "Select the previous root"
+ (select-generic-root #'anti-rotate-list nil))
+
+
+(defun select-next-root-restart-menu ()
+ "Select the next root"
+ (select-generic-root #'rotate-list t))
+
+(defun select-previous-root-restart-menu ()
+ "Select the previous root"
+ (select-generic-root #'anti-rotate-list t))
+
+
+(defun rotate-root-geometry-generic (fun restart-menu)
+ (no-focus)
+ (funcall fun)
+ (show-all-children t)
+ (if restart-menu
+ (open-menu (find-menu 'root-menu))
+ (leave-second-mode)))
+
+
+(defun rotate-root-geometry-next ()
+ "Rotate root geometry to next root"
+ (rotate-root-geometry-generic #'rotate-root-geometry nil))
+
+(defun rotate-root-geometry-previous ()
+ "Rotate root geometry to previous root"
+ (rotate-root-geometry-generic #'anti-rotate-root-geometry nil))
+
+(defun rotate-root-geometry-next-restart-menu ()
+ "Rotate root geometry to next root"
+ (rotate-root-geometry-generic #'rotate-root-geometry t))
+
+(defun rotate-root-geometry-previous-restart-menu ()
+ "Rotate root geometry to previous root"
+ (rotate-root-geometry-generic #'anti-rotate-root-geometry t))
+
+
+
+(defun exchange-root-geometry-with-mouse ()
+ "Exchange two root geometry pointed with the mouse"
+ (open-notify-window '("Select the first root to exchange"))
+ (wait-no-key-or-button-press)
+ (wait-mouse-button-release)
+ (close-notify-window)
+ (multiple-value-bind (x1 y1) (xlib:query-pointer *root*)
+ (open-notify-window '("Select the second root to exchange"))
+ (wait-no-key-or-button-press)
+ (wait-mouse-button-release)
+ (close-notify-window)
+ (multiple-value-bind (x2 y2) (xlib:query-pointer *root*)
+ (exchange-root-geometry (find-root-by-coordinates x1 y1)
+ (find-root-by-coordinates x2 y2))))
+ (leave-second-mode))
+
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index 43799be..c1049e4 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -90,10 +90,10 @@
(add-menu-key 'child-menu "Page_Up" 'frame-lower-child)
(add-menu-key 'child-menu "Page_Down" 'frame-raise-child)
-(add-menu-key 'root-menu "n" 'select-next-root)
-(add-menu-key 'root-menu "p" 'select-previous-root)
-(add-menu-key 'root-menu "g" 'rotate-root-geometry-next)
-(add-menu-key 'root-menu "f" 'rotate-root-geometry-previous)
+(add-menu-key 'root-menu "n" 'select-next-root-restart-menu)
+(add-menu-key 'root-menu "p" 'select-previous-root-restart-menu)
+(add-menu-key 'root-menu "g" 'rotate-root-geometry-next-restart-menu)
+(add-menu-key 'root-menu "f" 'rotate-root-geometry-previous-restart-menu)
(add-menu-key 'root-menu "m" 'exchange-root-geometry-with-mouse)
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 +++
src/bindings-second-mode.lisp | 2 +-
src/clfswm-circulate-mode.lisp | 37 -------------------
src/clfswm-internal.lisp | 15 ++++----
src/clfswm-menu.lisp | 7 +---
src/clfswm-util.lisp | 78 ++++++++++++++++++++++++++++++++++++++++
src/menu-def.lisp | 8 ++--
7 files changed, 98 insertions(+), 54 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list