[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-40-gaef0e41
Philippe Brochard
pbrochard at common-lisp.net
Tue May 15 20:54:50 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 aef0e417c99264a29d4b53ad71765598204cbe13 (commit)
from 2ba6a3ec1ce3c59ed674a1ff45cb97b9bfa99426 (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 aef0e417c99264a29d4b53ad71765598204cbe13
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue May 15 22:54:44 2012 +0200
src/clfswm-circulate-mode.lisp (rotate-root-geometry-next, rotate-root-geometry-previous): New second mode binding to change root geometry.
diff --git a/ChangeLog b/ChangeLog
index dd3b082..119b1cd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-05-15 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-circulate-mode.lisp (rotate-root-geometry-next)
+ (rotate-root-geometry-previous): New second mode binding to change
+ root geometry.
+
2012-05-13 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-internal.lisp: Remove the *current-child* variable
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index 3e4964a..fb98005 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -124,6 +124,8 @@
(define-second-key ("Page_Up") 'select-next-root)
(define-second-key ("Page_Down") 'select-previous-root)
+ (define-second-key ("Page_Up" :control) 'rotate-root-geometry-next)
+ (define-second-key ("Page_Down" :control) 'rotate-root-geometry-previous)
(define-second-key ("Right") 'speed-mouse-right)
(define-second-key ("Left") 'speed-mouse-left)
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index e69d8a9..3ec2d95 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -403,3 +403,18 @@
"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 adfc18d..4e4199e 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -374,11 +374,6 @@
, at body)))
-(defun is-in-current-child-p (child)
- (and (frame-p (current-child))
- (child-member child (frame-child (current-child)))))
-
-
;; (with-all-children (*root-frame* child) (typecase child (xlib:window (print child)) (frame (print (frame-number child)))))
(defmacro with-all-children ((root child) &body body)
@@ -525,9 +520,6 @@
(apply #'make-instance 'frame :number number :window window :gc gc args)))
-
-
-
(defun add-frame (frame parent)
(push frame (frame-child parent))
frame)
@@ -547,22 +539,6 @@
h (h-px->fl prh parent))
(xlib:display-finish-output *display*))))
-(defun fixe-real-size (frame parent)
- "Fixe real (pixel) coordinates in float coordinates"
- (when (frame-p frame)
- (with-slots (x y w h rx ry rw rh) frame
- (setf x (x-px->fl rx parent)
- y (y-px->fl ry parent)
- w (w-px->fl (anti-adj-border-wh rw parent) parent)
- h (h-px->fl (anti-adj-border-wh rh parent) parent)))))
-
-(defun fixe-real-size-current-child ()
- "Fixe real (pixel) coordinates in float coordinates for children in the current child"
- (when (frame-p (current-child))
- (dolist (child (frame-child (current-child)))
- (fixe-real-size child (current-child)))))
-
-
(defun find-child (to-find root)
@@ -665,14 +641,34 @@
(defun find-current-root ()
(root-child (find-root (current-child))))
+ (defun rotate-root-geometry ()
+ (let* ((current (first root-list))
+ (orig-x (root-x current))
+ (orig-y (root-y current))
+ (orig-w (root-w current))
+ (orig-h (root-h current)))
+ (dolist (root (rest root-list))
+ (setf (root-x current) (root-x root)
+ (root-y current) (root-y root)
+ (root-w current) (root-w root)
+ (root-h current) (root-h root)
+ current root))
+ (setf (root-x current) orig-x
+ (root-y current) orig-y
+ (root-w current) orig-w
+ (root-h current) orig-h)))
+
+ (defun anti-rotate-root-geometry ()
+ (setf root-list (nreverse root-list))
+ (rotate-root-geometry)
+ (setf root-list (nreverse root-list)))
+
(defun current-child ()
current-child)
(defun current-child-setter (value)
- (let ((current-root (find-root current-child)))
- (dolist (root root-list)
- (when (equal root current-root)
- (setf (root-current-child root) current-child))))
+ (awhen (find-root value)
+ (setf (root-current-child it) value))
(setf current-child value))
(defmacro with-current-child ((new-child) &body body)
@@ -683,12 +679,32 @@
(setf (current-child) ,new-child)
(let ((,ret (multiple-value-list (progn , at body))))
(setf (current-child) ,old-child)
- (values-list ,ret)))))
-)
+ (values-list ,ret))))))
(defsetf current-child current-child-setter)
+(defun is-in-current-child-p (child)
+ (and (frame-p (current-child))
+ (child-member child (frame-child (current-child)))))
+
+
+(defun fixe-real-size (frame parent)
+ "Fixe real (pixel) coordinates in float coordinates"
+ (when (frame-p frame)
+ (with-slots (x y w h rx ry rw rh) frame
+ (setf x (x-px->fl rx parent)
+ y (y-px->fl ry parent)
+ w (w-px->fl (anti-adj-border-wh rw parent) parent)
+ h (h-px->fl (anti-adj-border-wh rh parent) parent)))))
+
+(defun fixe-real-size-current-child ()
+ "Fixe real (pixel) coordinates in float coordinates for children in the current child"
+ (when (frame-p (current-child))
+ (dolist (child (frame-child (current-child)))
+ (fixe-real-size child (current-child)))))
+
+
;;; Multiple physical screen helper
(defun add-placed-frame-tmp (frame n) ;; For test
@@ -704,7 +720,7 @@
(parse-integer string :junk-allowed t))
(split-string (substitute #\space #\x (substitute #\space #\, line))))))
-(defun get-connected-heads-size (&optional (fake nil))
+(defun get-connected-heads-size (&optional (fake t))
(labels ((heads-info ()
(if (not fake)
(do-shell "xdpyinfo -ext XINERAMA")
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 6 +++
src/bindings-second-mode.lisp | 2 +
src/clfswm-circulate-mode.lisp | 15 ++++++++
src/clfswm-internal.lisp | 78 ++++++++++++++++++++++++----------------
4 files changed, 70 insertions(+), 31 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list