[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-31-g4f9a389
Philippe Brochard
pbrochard at common-lisp.net
Mon Apr 30 20:39:16 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 4f9a389cc04f1ed6358b1b7d782b4eceb045452d (commit)
via f53a1ad3bbffb633bd9d94bd35d16142e2cd74d2 (commit)
via f28ae04ded1d40b5229de45228c9127a984953f7 (commit)
via 0f9c05ecad39ded0dbbc94e068a118aae919b7c7 (commit)
via a1d04c54489f341f4762921fa361a5c26d55bfea (commit)
via d04fb387dad72bd36f0b2501027fe6797c33db66 (commit)
from dc020bc9d3df37ce55936bbe4f18d9ad0bde4f42 (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 4f9a389cc04f1ed6358b1b7d782b4eceb045452d
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Apr 30 22:34:59 2012 +0200
src/clfswm-internal.lisp: TODO update
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 7e10483..d99ea03 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -616,6 +616,8 @@
;;; Multiple roots support (replace the old *current-root* variable)
(let ((root-list nil)
(original-root-list nil))
+ ;; TODO: Add find-root-by-coordinates, change-root-geometry
+
(defun define-as-root (child x y width height)
(push (make-root :child child :x x :y y :w width :h height) root-list)
(push (make-root :child child :x x :y y :w width :h height) original-root-list))
commit f53a1ad3bbffb633bd9d94bd35d16142e2cd74d2
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Apr 30 22:26:06 2012 +0200
src/config.lisp: Do not use get-fullscreen-size anymore
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 3dbe83c..7e10483 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -838,16 +838,17 @@
(defun get-parent-layout (child parent)
(aif (child-root-p child)
- ;;(values-list (rest (child-root-p child)))
- (values (root-x it) (root-y it) (root-w it) (root-h it))
- (if (or (frame-p child) (managed-window-p child parent))
- (if (frame-p parent)
- (aif (frame-layout parent)
- (funcall it child parent)
- (no-layout child parent))
- (get-fullscreen-size))
- (values (x-drawable-x child) (x-drawable-y child)
- (x-drawable-width child) (x-drawable-height child)))))
+ (values (root-x it) (root-y it) (root-w it) (root-h it))
+ (if (or (frame-p child) (managed-window-p child parent))
+ (if (frame-p parent)
+ (aif (frame-layout parent)
+ (funcall it child parent)
+ (no-layout child parent))
+ (values (- *border-size*) (- *border-size*)
+ (xlib:screen-width *screen*)
+ (xlib:screen-height *screen*)))
+ (values (x-drawable-x child) (x-drawable-y child)
+ (x-drawable-width child) (x-drawable-height child)))))
diff --git a/src/config.lisp b/src/config.lisp
index a7481ce..253b037 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -73,18 +73,6 @@ A list of (list match-function handle-function)")
"Delay to display the new child after doing a spatial move")
-;;; CONFIG - Screen size
-(defun get-fullscreen-size ()
- "Return the size of root child (values rx ry rw rh)
-You can tweak this to what you want"
- (values (- *border-size*) (- *border-size*)
- (xlib:screen-width *screen*)
- (xlib:screen-height *screen*)))
- ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
-;; (values -1 -1 1024 768))
-;; (values 100 100 800 600))
-
-
(defconfig *corner-size* 3 'Corner
"The size of the corner square")
commit f28ae04ded1d40b5229de45228c9127a984953f7
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Apr 30 22:16:36 2012 +0200
src/clfswm-internal.lisp: Adapt prevent-current-*-equal-child
diff --git a/ChangeLog b/ChangeLog
index 68af51b..eb14f2c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-04-30 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp: Big change to replace *current-root*
+ variable to support multiple root.
+
2012-04-18 Philippe Brochard <pbrochard at common-lisp.net>
* src/tools.lisp (add-new-hook, add-hook): New macro. Do not
diff --git a/clfswm.asd b/clfswm.asd
index c908b3f..c11942d 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -7,7 +7,7 @@
(defsystem clfswm
:description "CLFSWM: Fullscreen Window Manager"
- :version "Please, see in src/version.lisp"
+ :version "1106"
:author "Philippe Brochard <hocwp at free.fr>"
:licence "GNU Public License (GPL)"
:components ((:module src
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 4e2c8e8..3dbe83c 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1282,14 +1282,15 @@ 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"
- (let* ((parent (find-parent-frame child))
- (parent-is-root-frame-p (child-equal-p parent *root-frame*)))
- (when (and (child-root-p child)
- (not parent-is-root-frame-p))
- (change-root child parent))
- (when (child-equal-p child *current-child*)
- (setf *current-child* (find-current-root)))
- (not parent-is-root-frame-p)))
+ (if (child-is-original-root-p child)
+ nil
+ (progn
+ (when (child-root-p child)
+ (change-root child (find-parent-frame child)))
+ (when (child-equal-p child *current-child*)
+ (setf *current-child* (find-current-root)))
+ t)))
+
(defun remove-child-in-frame (child frame)
commit 0f9c05ecad39ded0dbbc94e068a118aae919b7c7
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Apr 30 21:24:46 2012 +0200
src/*: Use a structure instead of a list in root-list
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 442e742..c623e19 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -96,8 +96,8 @@
(setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
(frame-selected-pos *circulate-parent*) 0
*current-child* (frame-selected-child *circulate-parent*))))
- (when (and (not (child-root *current-child*))
- (child-root old-child))
+ (when (and (not (child-root-p *current-child*))
+ (child-root-p old-child))
(change-root old-child *current-child*))))
(show-all-children t)
(draw-circulate-mode-window)))
@@ -294,7 +294,7 @@
(defun reorder-brother-simple (reorder-fun)
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(no-focus)
(select-current-frame nil)
(let ((parent-frame (find-parent-frame *current-child*)))
@@ -318,7 +318,7 @@
;;; Spatial move functions
(defun select-brother-generic-spatial-move (fun-found)
"Select the nearest brother of the current child based on the fun-found function"
- (let ((is-root-p (child-root *current-child*)))
+ (let ((is-root-p (child-root-p *current-child*)))
(when is-root-p
(leave-frame)
(sleep *spatial-move-delay-before*))
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index e962c70..eae9406 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -138,7 +138,7 @@
(defun expose-mode-display-accel-windows ()
(let ((n -1))
- (with-all-children-reversed (*current-root* child)
+ (with-all-children-reversed ((find-current-root) child)
(if (or (frame-p child)
(managed-window-p child (find-parent-frame child *root-frame*)))
(when (< n 61)
@@ -200,7 +200,7 @@
(defun expose-windows-mode ()
"Present all windows in the current frame (An expose like)"
(stop-button-event)
- (expose-windows-generic *current-root*))
+ (expose-windows-generic (find-current-root)))
(defun expose-all-windows-mode ()
"Present all windows in all frames (An expose like)"
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 47c6b71..4e2c8e8 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -617,41 +617,41 @@
(let ((root-list nil)
(original-root-list nil))
(defun define-as-root (child x y width height)
- (push (list child x y width height) root-list)
- (setf original-root-list (copy-tree root-list)))
+ (push (make-root :child child :x x :y y :w width :h height) root-list)
+ (push (make-root :child child :x x :y y :w width :h height) original-root-list))
(defun all-root-child ()
(loop for root in root-list
- collect (first root)))
+ collect (root-child root)))
- (defun child-root (child)
+ (defun child-root-p (child)
(dolist (root root-list)
- (when (child-equal-p child (first root))
+ (when (child-equal-p child (root-child root))
(return root))))
(defun change-root (old new)
- (let ((root (child-root old)))
+ (let ((root (child-root-p old)))
(when (and root new)
- (setf (first root) new))))
+ (setf (root-child root) new))))
(defun find-root (child)
- (if (child-root child)
+ (if (child-root-p child)
child
(awhen (find-parent-frame child)
(find-root it))))
(defun find-original-root (child)
(dolist (root original-root-list)
- (when (find-child child (first root))
+ (when (find-child child (root-child root))
(return-from find-original-root root))))
(defun child-is-original-root-p (child)
(dolist (root original-root-list)
- (when (child-equal-p child (first root))
+ (when (child-equal-p child (root-child root))
(return-from child-is-original-root-p t))))
(defun find-root-in-child (child)
- (if (child-root child)
+ (if (child-root-p child)
child
(when (frame-p child)
(dolist (c (frame-child child))
@@ -662,7 +662,7 @@
"Return a list of root in child"
(let ((roots nil))
(labels ((rec (child)
- (when (child-root child)
+ (when (child-root-p child)
(push child roots))
(when (frame-p child)
(dolist (c (frame-child child))
@@ -672,7 +672,7 @@
(defun find-child-in-all-root (child)
(dolist (root root-list)
- (when (find-child child (first root))
+ (when (find-child child (root-child root))
(return-from find-child-in-all-root root))))
(defun only-one-root-in-p (child)
@@ -683,7 +683,62 @@
(defun find-related-root (child)
(or (find-root-in-child child)
- (find-root-in-child (first (find-original-root child))))))
+ (find-root-in-child (root-child (find-original-root child))))))
+
+
+
+;;; Multiple physical screen helper
+(defun get-xrandr-connected-size ()
+ (let ((output (do-shell "xrandr"))
+ (sizes '()))
+ (loop for line = (read-line output nil nil)
+ while line
+ do
+ (awhen (search " connected " line)
+ (incf it (length " connected "))
+ (destructuring-bind (w h x y)
+ (mapcar #'parse-integer
+ (split-string (substitute #\space #\x
+ (substitute #\space #\+
+ (subseq line it (position #\space line :start it))))))
+ (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
+ (dbg sizes)
+ sizes))
+ ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250)))) ;;; For test
+
+(defun add-placed-frame-tmp (frame n)
+ (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame)
+ (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame)
+ (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame)
+ (when (plusp n)
+ (add-placed-frame-tmp (first (frame-child frame)) (1- n))))
+
+
+(defun place-frames-from-xrandr ()
+ "Place frames according to xrandr informations"
+ (let ((sizes (get-xrandr-connected-size))
+ (width (xlib:screen-width *screen*))
+ (height (xlib:screen-height *screen*)))
+ ;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
+ (if (<= (length sizes) 1)
+ (define-as-root *root-frame* (- *border-size*) (- *border-size*) width height)
+ (progn
+ (loop while (< (length (frame-child *root-frame*)) (length sizes))
+ do (let ((frame (create-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
+ (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-frame (create-frame) frame)
+ (define-as-root frame x y w h)))
+ (setf *current-child* (first (frame-child (first (frame-child *root-frame*)))))))))
+
+
(defun get-all-windows (&optional (root *root-frame*))
@@ -732,7 +787,7 @@
(setf (xlib:gcontext-background gc) (get-color *frame-background*)
(xlib:window-background window) (get-color *frame-background*))
(clear-pixmap-buffer window gc)
- (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root frame)
+ (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root-p frame)
(child-equal-p frame *current-child*))
*frame-foreground-root* *frame-foreground*)))
(xlib:draw-glyphs *pixmap-buffer* gc 5 dy
@@ -740,7 +795,7 @@
number
(if name (format nil " - ~A" name) "")))
(let ((pos dy))
- (when (child-root frame)
+ (when (child-root-p frame)
(when *child-selection*
(xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
(with-output-to-string (str)
@@ -782,8 +837,9 @@
(defun get-parent-layout (child parent)
- (if (child-root child)
- (values-list (rest (child-root child)))
+ (aif (child-root-p child)
+ ;;(values-list (rest (child-root-p child)))
+ (values (root-x it) (root-y it) (root-w it) (root-h it))
(if (or (frame-p child) (managed-window-p child parent))
(if (frame-p parent)
(aif (frame-layout parent)
@@ -856,7 +912,7 @@
(declare (ignore parent))
(with-slots (window show-window-p) frame
(if (and show-window-p
- (or *show-root-frame-p* (not (child-root frame))))
+ (or *show-root-frame-p* (not (child-root-p frame))))
(progn
(map-window window)
(set-child-stack-order window previous)
@@ -1022,7 +1078,7 @@
(setf previous (child-rect-child rect)))))
(rec (child parent selected-p in-current-root)
- (let ((child-current-root-p (child-root child)))
+ (let ((child-current-root-p (child-root-p child)))
(unless (in-displayed-list child)
(set-geometry child parent in-current-root child-current-root-p))
(when (frame-p child)
@@ -1031,7 +1087,7 @@
(not (in-displayed-list child)))
(select-and-display child parent selected-p)))))
- (rec *root-frame* nil t (child-root *root-frame*))
+ (rec *root-frame* nil t (child-root-p *root-frame*))
(display-displayed-child)
(dolist (child hidden-child)
(hide-child child))
@@ -1102,7 +1158,7 @@
"Set current root if parent is not in current root"
(let ((root (find-root child)))
(when (and window-parent
- (not (child-root child))
+ (not (child-root-p child))
(not (find-child parent root)))
(change-root root parent)
t)))
@@ -1129,7 +1185,7 @@ For window: set current child to window or its parent according to window-parent
(defun select-previous-level ()
"Select the previous level in frame"
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(select-current-frame :maybe)
(awhen (find-parent-frame *current-child*)
(setf *current-child* it))
@@ -1204,13 +1260,13 @@ 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*) (first (find-original-root *current-child*)))
+ (change-root (find-root *current-child*) (root-child (find-original-root *current-child*)))
(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 (first (find-original-root *current-child*))))
+ (let ((new-root (root-child (find-original-root *current-child*))))
(change-root (find-root *current-child*) new-root)
(setf *current-child* new-root))
(unless show-later
@@ -1228,7 +1284,7 @@ For window: set current child to window or its parent according to window-parent
" Prevent current-root and current-child equal to child"
(let* ((parent (find-parent-frame child))
(parent-is-root-frame-p (child-equal-p parent *root-frame*)))
- (when (and (child-root child)
+ (when (and (child-root-p child)
(not parent-is-root-frame-p))
(change-root child parent))
(when (child-equal-p child *current-child*)
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index 0559843..99355a2 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -46,7 +46,6 @@
(let ((frame (if (xlib:window-p *current-child*)
(find-parent-frame *current-child*)
*current-child*)))
- (dbg (child-is-original-root-p frame))
(unless (or (child-member frame *permanent-nw-hook-frames*)
(child-is-original-root-p frame))
(setf (frame-nw-hook frame) hook)
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index 8dbabe0..cf525ef 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -240,7 +240,7 @@
(frame-w child) (w-px->fl (anti-adj-border-wh (x-drawable-width (frame-window child)) parent) parent)
(frame-h child) (h-px->fl (anti-adj-border-wh (x-drawable-height (frame-window child)) parent) parent))))))
(defun move-frame-constrained (frame parent orig-x orig-y)
- (when (and frame parent (not (child-root frame)))
+ (when (and frame parent (not (child-root-p frame)))
(hide-all-children frame)
(with-slots (window) frame
(let ((lx orig-x)
@@ -285,7 +285,7 @@
(defun resize-frame-constrained (frame parent orig-x orig-y)
- (when (and frame parent (not (child-root frame)))
+ (when (and frame parent (not (child-root-p frame)))
(hide-all-children frame)
(with-slots (window) frame
(let ((lx orig-x)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index e873ec2..1d48e55 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -118,7 +118,7 @@
(parent (find-parent-frame *current-child*)))
(when (and parent (only-one-root-in-p parent))
(pushnew new-frame (frame-child parent))
- (when (child-root *current-child*)
+ (when (child-root-p *current-child*)
(change-root *current-child* parent))
(setf *current-child* parent)
(set-layout-once #'tile-space-layout)
@@ -244,7 +244,7 @@
(defun cut-current-child (&optional (show-now t))
"Cut the current child to the selection"
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(hide-all *current-child*)
(copy-current-child)
@@ -257,7 +257,7 @@
(defun remove-current-child ()
"Remove the current child from its parent frame"
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(hide-all *current-child*)
(remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
@@ -268,7 +268,7 @@
(defun delete-current-child ()
"Delete the current child and its children in all frames"
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(hide-all *current-child*)
(delete-child-and-children-in-all-frames *current-child*)
(show-all-children t)
@@ -492,7 +492,7 @@
;;; Delete by functions
(defun delete-frame-by (frame)
(unless (or (child-equal-p frame *root-frame*)
- (child-root frame))
+ (child-root-p frame))
(when (child-equal-p frame *current-child*)
(setf *current-child* (find-current-root)))
(remove-child-in-frame frame (find-parent-frame frame)))
@@ -579,7 +579,7 @@
(defun move-frame (frame parent orig-x orig-y)
- (when (and frame parent (not (child-root frame)))
+ (when (and frame parent (not (child-root-p frame)))
(hide-all-children frame)
(with-slots (window) frame
(move-window window orig-x orig-y #'display-frame-info (list frame))
@@ -588,7 +588,7 @@
(show-all-children)))
(defun resize-frame (frame parent orig-x orig-y)
- (when (and frame parent (not (child-root frame)))
+ (when (and frame parent (not (child-root-p frame)))
(hide-all-children frame)
(with-slots (window) frame
(resize-window window orig-x orig-y #'display-frame-info (list frame))
@@ -604,7 +604,7 @@ mouse-fun is #'move-frame or #'resize-frame"
(let* ((to-replay t)
(child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child))
- (root-p (child-root child)))
+ (root-p (child-root-p child)))
(labels ((add-new-frame ()
(when (frame-p child)
(setf parent child
@@ -616,10 +616,10 @@ mouse-fun is #'move-frame or #'resize-frame"
(pushnew child (frame-child parent)))))
(when (and root-p *create-frame-on-root*)
(add-new-frame))
- (when (and (frame-p child) (not (child-root child)))
+ (when (and (frame-p child) (not (child-root-p child)))
(funcall mouse-fn child parent root-x root-y))
(when (and child parent
- (focus-all-children child parent (not (child-root child))))
+ (focus-all-children child parent (not (child-root-p child))))
(when (show-all-children)
(setf to-replay nil)))
(if to-replay
@@ -659,7 +659,7 @@ For window: set current child to window or its parent according to window-parent
(let ((parent (find-parent-frame child)))
(when (and parent child
(frame-p child)
- (child-root child))
+ (child-root-p child))
(setf parent child
child (create-frame)
mouse-fn #'resize-frame)
@@ -1060,7 +1060,7 @@ For window: set current child to window or its parent according to window-parent
"Move the child under the mouse cursor to another frame"
(declare (ignore window))
(let ((child (find-child-under-mouse root-x root-y)))
- (unless (child-root child)
+ (unless (child-root-p child)
(hide-all child)
(remove-child-in-frame child (find-parent-frame child))
(wait-mouse-button-release 50 51)
@@ -1099,7 +1099,7 @@ For window: set current child to window or its parent according to window-parent
;;; Hide/Unhide current child
(defun hide-current-child ()
"Hide the current child"
- (unless (child-root *current-child*)
+ (unless (child-root-p *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(when (frame-p parent)
(with-slots (child hidden-children) parent
@@ -1655,54 +1655,10 @@ For window: set current child to window or its parent according to window-parent
(decf (child-transparency window) 0.1)))
-;;; Multiple physical screen helper
-(defun get-xrandr-connected-size ()
- (let ((output (do-shell "xrandr"))
- (sizes '()))
- (loop for line = (read-line output nil nil)
- while line
- do
- (awhen (search " connected " line)
- (incf it (length " connected "))
- (push (mapcar #'parse-integer
- (split-string (substitute #\space #\x
- (substitute #\space #\+
- (subseq line it (position #\space line :start it))))))
- sizes)))
- sizes
- '((10 10 500 300) (520 20 480 300) (310 330 600 250))))
-
-(defun add-placed-frame-tmp (frame n)
- (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame)
- (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame)
- (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame)
- (when (plusp n)
- (add-placed-frame-tmp (first (frame-child frame)) (1- n))))
-
-
-(defun place-frames-from-xrandr ()
- "Place frames according to xrandr informations"
- (let ((sizes (get-xrandr-connected-size))
- (width (xlib:screen-width *screen*))
- (height (xlib:screen-height *screen*)))
- (add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
- (loop while (< (length (frame-child *root-frame*)) (length sizes))
- do (let ((frame (create-frame)))
- (add-frame frame *root-frame*)
- (add-placed-frame-tmp frame 2)))
- (setf *current-child* (first (frame-child *root-frame*)))
- (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)))
- (define-as-root frame x y w h)))))
-
+;;; Geometry change functions
(defun swap-frame-geometry ()
"Swap current brother frame geometry"
(when (frame-p *current-child*)
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 1df7bf7..bb642e3 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -121,7 +121,7 @@
(focus-window window)))
(:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child)))
- (unless (or (child-root child)
+ (unless (or (child-root-p child)
(equal (typecase child
(xlib:window parent)
(t child))
diff --git a/src/package.lisp b/src/package.lisp
index b3c82e8..d25600d 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -51,7 +51,7 @@ It is particulary useful with CLISP/MIT-CLX.")
(defconfig *default-transparency* 0.6 nil
"Default transparency for all windows when in xcompmgr transparency mode")
-(defconfig *show-root-frame-p* t nil
+(defconfig *show-root-frame-p* nil nil
"Show the root frame information or not")
@@ -118,6 +118,7 @@ It is particulary useful with CLISP/MIT-CLX.")
(defstruct child-rect child parent selected-p x y w h)
+(defstruct root child x y w h)
(defclass frame ()
((name :initarg :name :accessor frame-name :initform nil)
commit a1d04c54489f341f4762921fa361a5c26d55bfea
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sat Apr 28 23:18:41 2012 +0200
Replace the *current-root* variable in clfswm-nw-hooks.lisp
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index cdad772..47c6b71 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -645,6 +645,11 @@
(when (find-child child (first root))
(return-from find-original-root root))))
+ (defun child-is-original-root-p (child)
+ (dolist (root original-root-list)
+ (when (child-equal-p child (first root))
+ (return-from child-is-original-root-p t))))
+
(defun find-root-in-child (child)
(if (child-root child)
child
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index 327dcd6..0559843 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -46,7 +46,9 @@
(let ((frame (if (xlib:window-p *current-child*)
(find-parent-frame *current-child*)
*current-child*)))
- (unless (child-member frame *permanent-nw-hook-frames*)
+ (dbg (child-is-original-root-p frame))
+ (unless (or (child-member frame *permanent-nw-hook-frames*)
+ (child-is-original-root-p frame))
(setf (frame-nw-hook frame) hook)
(leave-second-mode))))
@@ -105,10 +107,11 @@
(defun open-in-current-root-nw-hook (frame window)
"Open the next window in the current root"
(clear-nw-hook frame)
- (leave-if-not-frame *current-root*)
- (pushnew window (frame-child *current-root*))
- (setf *current-child* (frame-selected-child *current-root*))
- (default-window-placement *current-root* window)
+ (leave-if-not-frame (find-current-root))
+ (let ((root (find-current-root)))
+ (pushnew window (frame-child root))
+ (setf *current-child* (frame-selected-child root))
+ (default-window-placement root window))
t)
(defun set-open-in-current-root-nw-hook ()
@@ -122,9 +125,10 @@
(defun open-in-new-frame-in-current-root-nw-hook (frame window)
"Open the next window in a new frame in the current root"
(clear-nw-hook frame)
- (leave-if-not-frame *current-root*)
- (let ((new-frame (create-frame)))
- (pushnew new-frame (frame-child *current-root*))
+ (leave-if-not-frame (find-current-root))
+ (let ((new-frame (create-frame))
+ (root (find-current-root)))
+ (pushnew new-frame (frame-child root))
(pushnew window (frame-child new-frame))
(setf *current-child* new-frame)
(default-window-placement new-frame window))
@@ -141,11 +145,12 @@
(defun open-in-new-frame-in-root-frame-nw-hook (frame window)
"Open the next window in a new frame in the root frame"
(clear-nw-hook frame)
- (let ((new-frame (create-frame)))
- (pushnew new-frame (frame-child *root-frame*))
+ (let ((new-frame (create-frame))
+ (root (find-current-root)))
+ (pushnew new-frame (frame-child root))
(pushnew window (frame-child new-frame))
(switch-to-root-frame :show-later t)
- (setf *current-child* *current-root*)
+ (setf *current-child* root)
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
(default-window-placement new-frame window))
@@ -167,8 +172,8 @@
(when parent
(pushnew new-frame (frame-child parent))
(pushnew window (frame-child new-frame))
- (setf *current-root* parent
- *current-child* parent)
+ (change-root (find-related-root parent) parent)
+ (setf *current-child* parent)
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
(default-window-placement new-frame window)
@@ -209,8 +214,8 @@
(defun nw-hook-open-in-frame (window frame)
(when (frame-p frame)
(pushnew window (frame-child frame))
- (unless (find-child frame *current-root*)
- (setf *current-root* frame))
+ (unless (find-child-in-all-root frame)
+ (change-root (find-related-root frame) frame))
(setf *current-child* frame)
(focus-all-children window frame)
(default-window-placement frame window)
@@ -255,8 +260,8 @@
(funcall absorb-nw-test window))
(pushnew window (frame-child frame))
(unless *in-process-existing-windows*
- (unless (find-child frame *current-root*)
- (setf *current-root* frame))
+ (unless (find-child-in-all-root frame)
+ (change-root (find-related-root frame) frame))
(setf *current-child* frame)
(focus-all-children window frame)
(default-window-placement frame window)
commit d04fb387dad72bd36f0b2501027fe6797c33db66
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Fri Apr 27 23:07:26 2012 +0200
Big change to replace *current-root* variable to support multiple root
diff --git a/TODO b/TODO
index e615c5c..536ce34 100644
--- a/TODO
+++ b/TODO
@@ -16,6 +16,8 @@ FOR THE NEXT RELEASE
- Add a modeline in contrib/
+- Add completion in query input.
+
MAYBE
=====
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 618568a..442e742 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -85,8 +85,7 @@
(defun reorder-brother (direction)
(no-focus)
- (let ((frame-is-root? (and (child-equal-p *current-root* *current-child*)
- (not (child-equal-p *current-root* *root-frame*)))))
+ (let ((old-child *current-child*))
(select-current-frame nil)
(unless (and *circulate-orig* *circulate-parent*)
(reset-circulate-brother))
@@ -97,8 +96,9 @@
(setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
(frame-selected-pos *circulate-parent*) 0
*current-child* (frame-selected-child *circulate-parent*))))
- (when frame-is-root?
- (setf *current-root* *current-child*))))
+ (when (and (not (child-root *current-child*))
+ (child-root old-child))
+ (change-root old-child *current-child*))))
(show-all-children t)
(draw-circulate-mode-window)))
@@ -294,7 +294,7 @@
(defun reorder-brother-simple (reorder-fun)
- (unless (child-equal-p *current-child* *current-root*)
+ (unless (child-root *current-child*)
(no-focus)
(select-current-frame nil)
(let ((parent-frame (find-parent-frame *current-child*)))
@@ -318,8 +318,8 @@
;;; Spatial move functions
(defun select-brother-generic-spatial-move (fun-found)
"Select the nearest brother of the current child based on the fun-found function"
- (let ((is-root? (child-equal-p *current-child* *current-root*)))
- (when is-root?
+ (let ((is-root-p (child-root *current-child*)))
+ (when is-root-p
(leave-frame)
(sleep *spatial-move-delay-before*))
(no-focus)
@@ -342,7 +342,7 @@
selected-pos 0
child (cons found (child-remove found child)))))))
(show-all-children t)
- (when is-root?
+ (when is-root-p
(sleep *spatial-move-delay-after*)
(enter-frame)))))
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 2e50f7a..5364a54 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -61,7 +61,7 @@ Corner is one of :bottom-right :bottom-left :top-right :top-left"
(defun do-corner-action (x y corner-list)
"Do the action associated with corner. The corner function must return T to
stop the button event"
- (when (frame-p *current-root*)
+ (when (frame-p (find-current-root))
(let ((corner (find-corner x y)))
(when corner
(let ((fun (second (assoc corner corner-list))))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 2331401..cdad772 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -132,6 +132,8 @@
nil)
+
+
(declaim (inline child-member child-remove child-position))
(defun child-member (child list)
@@ -368,19 +370,6 @@
, at body)))
-(defgeneric rename-child (child name))
-
-(defmethod rename-child ((child frame) name)
- (setf (frame-name child) name)
- (display-frame-info child))
-
-(defmethod rename-child ((child xlib:window) name)
- (setf (xlib:wm-name child) name))
-
-(defmethod rename-child (child name)
- (declare (ignore child name)))
-
-
(defun is-in-current-child-p (child)
(and (frame-p *current-child*)
(child-member child (frame-child *current-child*))))
@@ -624,6 +613,72 @@
(rec base)))
+;;; Multiple roots support (replace the old *current-root* variable)
+(let ((root-list nil)
+ (original-root-list nil))
+ (defun define-as-root (child x y width height)
+ (push (list child x y width height) root-list)
+ (setf original-root-list (copy-tree root-list)))
+
+ (defun all-root-child ()
+ (loop for root in root-list
+ collect (first root)))
+
+ (defun child-root (child)
+ (dolist (root root-list)
+ (when (child-equal-p child (first root))
+ (return root))))
+
+ (defun change-root (old new)
+ (let ((root (child-root old)))
+ (when (and root new)
+ (setf (first root) new))))
+
+ (defun find-root (child)
+ (if (child-root child)
+ child
+ (awhen (find-parent-frame child)
+ (find-root it))))
+
+ (defun find-original-root (child)
+ (dolist (root original-root-list)
+ (when (find-child child (first root))
+ (return-from find-original-root root))))
+
+ (defun find-root-in-child (child)
+ (if (child-root 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 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 (first 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 (first (find-original-root child))))))
(defun get-all-windows (&optional (root *root-frame*))
@@ -672,7 +727,7 @@
(setf (xlib:gcontext-background gc) (get-color *frame-background*)
(xlib:window-background window) (get-color *frame-background*))
(clear-pixmap-buffer window gc)
- (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-equal-p frame *current-root*)
+ (setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root frame)
(child-equal-p frame *current-child*))
*frame-foreground-root* *frame-foreground*)))
(xlib:draw-glyphs *pixmap-buffer* gc 5 dy
@@ -680,7 +735,7 @@
number
(if name (format nil " - ~A" name) "")))
(let ((pos dy))
- (when (child-equal-p frame *current-root*)
+ (when (child-root frame)
(when *child-selection*
(xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
(with-output-to-string (str)
@@ -697,17 +752,33 @@
(values t t)))))
-(defun display-all-frame-info (&optional (root *current-root*))
- (with-all-frames (root frame)
+(defun display-all-frame-info ()
+ (with-all-frames (*root-frame* frame)
(display-frame-info frame)))
+(defun display-all-root-frame-info ()
+ (dolist (root (all-root-child))
+ (display-frame-info root)))
+
+
+(defgeneric rename-child (child name))
+
+(defmethod rename-child ((child frame) name)
+ (setf (frame-name child) name)
+ (display-frame-info child))
+
+(defmethod rename-child ((child xlib:window) name)
+ (setf (xlib:wm-name child) name))
+
+(defmethod rename-child (child name)
+ (declare (ignore child name)))
(defun get-parent-layout (child parent)
- (if (child-equal-p child *current-root*)
- (get-fullscreen-size)
+ (if (child-root child)
+ (values-list (rest (child-root child)))
(if (or (frame-p child) (managed-window-p child parent))
(if (frame-p parent)
(aif (frame-layout parent)
@@ -780,7 +851,7 @@
(declare (ignore parent))
(with-slots (window show-window-p) frame
(if (and show-window-p
- (or *show-root-frame-p* (not (child-equal-p frame *current-root*))))
+ (or *show-root-frame-p* (not (child-root frame))))
(progn
(map-window window)
(set-child-stack-order window previous)
@@ -849,7 +920,7 @@
(select-child *current-child* selected))
(defun unselect-all-frames ()
- (with-all-children (*current-root* child)
+ (with-all-children (*root-frame* child)
(select-child child nil)))
@@ -895,8 +966,7 @@
(defun show-all-children (&optional (from-root-frame nil))
- "Show all children from *current-root*. When from-root-frame is true
-Display all children from root frame and hide those not in *current-root*"
+ "Show all children and hide those not in a root frame"
(let ((geometry-change nil)
(displayed-child nil)
(hidden-child nil))
@@ -947,7 +1017,7 @@ Display all children from root frame and hide those not in *current-root*"
(setf previous (child-rect-child rect)))))
(rec (child parent selected-p in-current-root)
- (let ((child-current-root-p (child-equal-p child *current-root*)))
+ (let ((child-current-root-p (child-root child)))
(unless (in-displayed-list child)
(set-geometry child parent in-current-root child-current-root-p))
(when (frame-p child)
@@ -956,8 +1026,7 @@ Display all children from root frame and hide those not in *current-root*"
(not (in-displayed-list child)))
(select-and-display child parent selected-p)))))
- (rec (if from-root-frame *root-frame* *current-root*)
- nil t (child-equal-p *current-root* *root-frame*))
+ (rec *root-frame* nil t (child-root *root-frame*))
(display-displayed-child)
(dolist (child hidden-child)
(hide-child child))
@@ -968,8 +1037,6 @@ Display all children from root frame and hide those not in *current-root*"
-
-
(defun hide-all-children (root &optional except)
"Hide all root children"
(when (and (frame-p root) (not (child-equal-p root except)))
@@ -1028,19 +1095,20 @@ Display all children from root frame and hide those not in *current-root*"
(defun set-current-root (child parent window-parent)
"Set current root if parent is not in current root"
- (when (and window-parent
- (not (child-equal-p child *current-root*))
- (not (find-child parent *current-root*)))
- (setf *current-root* parent)
- t))
+ (let ((root (find-root child)))
+ (when (and window-parent
+ (not (child-root child))
+ (not (find-child parent root)))
+ (change-root root parent)
+ t)))
(defun focus-all-children (child parent &optional (window-parent t))
"Focus child and its parents -
For window: set current child to window or its parent according to window-parent"
(let ((new-focus (focus-child-rec child parent))
- (new-current-child (set-current-child child parent window-parent))
- (new-root (set-current-root child parent window-parent)))
+ (new-current-child (set-current-child child parent window-parent))
+ (new-root (set-current-root child parent window-parent)))
(or new-focus new-current-child new-root)))
@@ -1056,27 +1124,29 @@ For window: set current child to window or its parent according to window-parent
(defun select-previous-level ()
"Select the previous level in frame"
- (unless (child-equal-p *current-child* *current-root*)
+ (unless (child-root *current-child*)
(select-current-frame :maybe)
(awhen (find-parent-frame *current-child*)
(setf *current-child* it))
(show-all-children)))
-
(defun enter-frame ()
"Enter in the selected frame - ie make it the root frame"
- (setf *current-root* *current-child*)
- (show-all-children t))
+ (let ((root (find-root *current-child*)))
+ (unless (child-equal-p 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"
- (unless (child-equal-p *current-root* *root-frame*)
- (hide-all *current-root* (get-first-window))
- (awhen (find-parent-frame *current-root*)
- (when (frame-p it)
- (setf *current-root* it)))
- (show-all-children)))
+ (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))
+ (change-root root it)))
+ (show-all-children))))
;;; Other actions (select-next-child, select-next-brother...) are in
@@ -1129,14 +1199,15 @@ 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"
- (setf *current-root* *root-frame*)
+ (change-root (find-root *current-child*) (first (find-original-root *current-child*)))
(unless show-later
(show-all-children t)))
(defun switch-and-select-root-frame (&key (show-later nil))
"Switch and select the root frame"
- (setf *current-root* *root-frame*)
- (setf *current-child* *current-root*)
+ (let ((new-root (first (find-original-root *current-child*))))
+ (change-root (find-root *current-child*) new-root)
+ (setf *current-child* new-root))
(unless show-later
(show-all-children t)))
@@ -1150,10 +1221,14 @@ 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"
- (when (child-equal-p child *current-root*)
- (setf *current-root* (find-parent-frame child)))
- (when (child-equal-p child *current-child*)
- (setf *current-child* *current-root*)))
+ (let* ((parent (find-parent-frame child))
+ (parent-is-root-frame-p (child-equal-p parent *root-frame*)))
+ (when (and (child-root child)
+ (not parent-is-root-frame-p))
+ (change-root child parent))
+ (when (child-equal-p child *current-child*)
+ (setf *current-child* (find-current-root)))
+ (not parent-is-root-frame-p)))
(defun remove-child-in-frame (child frame)
@@ -1169,8 +1244,8 @@ For window: set current child to window or its parent according to window-parent
(defun remove-child-in-all-frames (child)
"Remove child in all frames from *root-frame*"
- (prevent-current-*-equal-child child)
- (remove-child-in-frames child *root-frame*))
+ (when (prevent-current-*-equal-child child)
+ (remove-child-in-frames child *root-frame*)))
(defun delete-child-in-frames (child root)
@@ -1187,8 +1262,8 @@ Warning:frame window and gc are freeed."
(defun delete-child-in-all-frames (child)
"Delete child in all frames from *root-frame*"
- (prevent-current-*-equal-child child)
- (delete-child-in-frames child *root-frame*))
+ (when (prevent-current-*-equal-child child)
+ (delete-child-in-frames child *root-frame*)))
(defun delete-child-and-children-in-frames (child root)
"Delete child and its children in the frame root and in all its children
@@ -1200,11 +1275,11 @@ Warning:frame window and gc are freeed."
(defun delete-child-and-children-in-all-frames (child &optional (close-methode 'delete-window))
"Delete child and its children in all frames from *root-frame*"
- (prevent-current-*-equal-child child)
- (delete-child-and-children-in-frames child *root-frame*)
- (when (xlib:window-p child)
- (funcall close-methode child))
- (show-all-children))
+ (when (prevent-current-*-equal-child child)
+ (delete-child-and-children-in-frames child *root-frame*)
+ (when (xlib:window-p child)
+ (funcall close-methode child))
+ (show-all-children)))
(defun clean-windows-in-all-frames ()
@@ -1214,9 +1289,9 @@ Warning:frame window and gc are freeed."
(dolist (child (frame-child frame))
(when (xlib:window-p child)
(unless (member child x-tree :test #'xlib:window-equal)
- (prevent-current-*-equal-child child)
- (setf (frame-child frame)
- (child-remove child (frame-child frame)))))))))
+ (when (prevent-current-*-equal-child child)
+ (setf (frame-child frame)
+ (child-remove child (frame-child frame))))))))))
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index 16434b7..8dbabe0 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -240,7 +240,7 @@
(frame-w child) (w-px->fl (anti-adj-border-wh (x-drawable-width (frame-window child)) parent) parent)
(frame-h child) (h-px->fl (anti-adj-border-wh (x-drawable-height (frame-window child)) parent) parent))))))
(defun move-frame-constrained (frame parent orig-x orig-y)
- (when (and frame parent (not (child-equal-p frame *current-root*)))
+ (when (and frame parent (not (child-root frame)))
(hide-all-children frame)
(with-slots (window) frame
(let ((lx orig-x)
@@ -285,7 +285,7 @@
(defun resize-frame-constrained (frame parent orig-x orig-y)
- (when (and frame parent (not (child-equal-p frame *current-root*)))
+ (when (and frame parent (not (child-root frame)))
(hide-all-children frame)
(with-slots (window) frame
(let ((lx orig-x)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 553cdfb..e873ec2 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -116,10 +116,10 @@
"Add a frame in the parent frame (and reorganize parent frame)"
(let ((new-frame (create-frame))
(parent (find-parent-frame *current-child*)))
- (when parent
+ (when (and parent (only-one-root-in-p parent))
(pushnew new-frame (frame-child parent))
- (when (child-equal-p *current-child* *current-root*)
- (setf *current-root* parent))
+ (when (child-root *current-child*)
+ (change-root *current-child* parent))
(setf *current-child* parent)
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
@@ -145,7 +145,7 @@
(defun delete-focus-window-generic (close-fun)
(with-focus-window (window)
(when (child-equal-p window *current-child*)
- (setf *current-child* *current-root*))
+ (setf *current-child* (find-current-root)))
(delete-child-and-children-in-all-frames window close-fun)))
(defun delete-focus-window ()
@@ -159,7 +159,7 @@
(defun remove-focus-window ()
"Remove the focus window from the current frame"
(with-focus-window (window)
- (setf *current-child* *current-root*)
+ (setf *current-child* (find-current-root))
(hide-child window)
(remove-child-in-frame window (find-parent-frame window))
(show-all-children)))
@@ -179,8 +179,9 @@
(defun find-window-under-mouse (x y)
"Return the child window under the mouse"
(let ((win *root*))
- (with-all-windows-frames-and-parent (*current-root* child parent)
+ (with-all-windows-frames-and-parent (*root-frame* child parent)
(when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+ (not (window-hidden-p child))
(in-window child x y))
(setf win child))
(when (in-frame child x y)
@@ -205,7 +206,7 @@
(defun find-child-under-mouse-in-child-tree (x y &optional first-foundp)
"Return the child under the mouse"
(let ((ret nil))
- (with-all-windows-frames-and-parent (*current-root* child parent)
+ (with-all-windows-frames-and-parent (*root-frame* child parent)
(when (and (not (window-hidden-p child))
(or (managed-window-p child parent) (child-equal-p parent *current-child*))
(in-window child x y))
@@ -233,21 +234,21 @@
(defun clear-selection ()
"Clear the current selection"
(setf *child-selection* nil)
- (display-frame-info *current-root*))
+ (display-all-root-frame-info))
(defun copy-current-child ()
"Copy the current child to the selection"
(pushnew *current-child* *child-selection*)
- (display-frame-info *current-root*))
+ (display-all-root-frame-info))
(defun cut-current-child (&optional (show-now t))
"Cut the current child to the selection"
- (unless (child-equal-p *current-child* *current-root*)
+ (unless (child-root *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(hide-all *current-child*)
(copy-current-child)
- (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*))
+ (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
(when parent
(setf *current-child* parent))
(when show-now
@@ -256,10 +257,10 @@
(defun remove-current-child ()
"Remove the current child from its parent frame"
- (unless (child-equal-p *current-child* *current-root*)
+ (unless (child-root *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(hide-all *current-child*)
- (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*))
+ (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
(when parent
(setf *current-child* parent))
(show-all-children t)
@@ -267,10 +268,11 @@
(defun delete-current-child ()
"Delete the current child and its children in all frames"
- (hide-all *current-child*)
- (delete-child-and-children-in-all-frames *current-child*)
- (show-all-children t)
- (leave-second-mode))
+ (unless (child-root *current-child*)
+ (hide-all *current-child*)
+ (delete-child-and-children-in-all-frames *current-child*)
+ (show-all-children t)
+ (leave-second-mode)))
(defun paste-selection-no-clear ()
@@ -286,7 +288,7 @@
(when (frame-p *current-child*)
(paste-selection-no-clear)
(setf *child-selection* nil)
- (display-frame-info *current-root*)))
+ (display-all-root-frame-info)))
(defun copy-focus-window ()
@@ -451,7 +453,7 @@
;;; Focus by functions
(defun focus-frame-by (frame)
(when (frame-p frame)
- (focus-all-children frame (or (find-parent-frame frame *current-root*)
+ (focus-all-children frame (or (find-parent-frame frame (find-current-root))
(find-parent-frame frame)
*root-frame*))
(show-all-children t)))
@@ -489,11 +491,10 @@
;;; Delete by functions
(defun delete-frame-by (frame)
- (unless (child-equal-p frame *root-frame*)
- (when (child-equal-p frame *current-root*)
- (setf *current-root* *root-frame*))
+ (unless (or (child-equal-p frame *root-frame*)
+ (child-root frame))
(when (child-equal-p frame *current-child*)
- (setf *current-child* *current-root*))
+ (setf *current-child* (find-current-root)))
(remove-child-in-frame frame (find-parent-frame frame)))
(show-all-children t))
@@ -561,15 +562,13 @@
"Show all frames info windows"
(let ((*show-root-frame-p* t))
(show-all-children)
- (with-all-frames (*current-root* frame)
- (raise-window (frame-window frame))
- (display-frame-info frame))))
+ (dolist (root (all-root-child))
+ (with-all-frames (root frame)
+ (raise-window (frame-window frame))
+ (display-frame-info frame)))))
(defun hide-all-frames-info ()
"Hide all frames info windows"
- (with-all-windows (*current-root* window)
- (raise-window window))
- (hide-child *current-root*)
(show-all-children))
(defun show-all-frames-info-key ()
@@ -580,7 +579,7 @@
(defun move-frame (frame parent orig-x orig-y)
- (when (and frame parent (not (child-equal-p frame *current-root*)))
+ (when (and frame parent (not (child-root frame)))
(hide-all-children frame)
(with-slots (window) frame
(move-window window orig-x orig-y #'display-frame-info (list frame))
@@ -589,7 +588,7 @@
(show-all-children)))
(defun resize-frame (frame parent orig-x orig-y)
- (when (and frame parent (not (child-equal-p frame *current-root*)))
+ (when (and frame parent (not (child-root frame)))
(hide-all-children frame)
(with-slots (window) frame
(resize-window window orig-x orig-y #'display-frame-info (list frame))
@@ -605,28 +604,24 @@ mouse-fun is #'move-frame or #'resize-frame"
(let* ((to-replay t)
(child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child))
- (root-p (child-equal-p child *current-root*)))
+ (root-p (child-root child)))
(labels ((add-new-frame ()
(when (frame-p child)
- (setf child (create-frame)
- parent *current-root*
+ (setf parent child
+ child (create-frame)
mouse-fn #'resize-frame
*current-child* child)
(place-frame child parent root-x root-y 10 10)
(map-window (frame-window child))
- (pushnew child (frame-child *current-root*)))))
- (when (or (not root-p) *create-frame-on-root*)
- (when root-p
- (add-new-frame))
- (when (and (frame-p child) (not (child-equal-p child *current-root*)))
- (funcall mouse-fn child parent root-x root-y))
- (when (and child parent
- (not root-p)
- (focus-all-children child parent
- (not (and (child-equal-p *current-child* *current-root*)
- (xlib:window-p *current-root*)))))
- (when (show-all-children)
- (setf to-replay nil))))
+ (pushnew child (frame-child parent)))))
+ (when (and root-p *create-frame-on-root*)
+ (add-new-frame))
+ (when (and (frame-p child) (not (child-root child)))
+ (funcall mouse-fn child parent root-x root-y))
+ (when (and child parent
+ (focus-all-children child parent (not (child-root child))))
+ (when (show-all-children)
+ (setf to-replay nil)))
(if to-replay
(replay-button-event)
(stop-button-event)))))
@@ -662,15 +657,16 @@ Focus child and its parents -
For window: set current child to window or its parent according to window-parent"
(labels ((move/resize-managed (child)
(let ((parent (find-parent-frame child)))
- (when (and (child-equal-p child *current-root*)
- (frame-p *current-root*))
- (setf child (create-frame)
- parent *current-root*
+ (when (and parent child
+ (frame-p child)
+ (child-root child))
+ (setf parent child
+ child (create-frame)
mouse-fn #'resize-frame)
(place-frame child parent root-x root-y 10 10)
(map-window (frame-window child))
- (pushnew child (frame-child *current-root*)))
- (focus-all-children child parent window-parent)
+ (push child (frame-child parent)))
+ (focus-all-children child parent window-parent)
(show-all-children)
(typecase child
(xlib:window
@@ -698,9 +694,6 @@ For window: set current child to window or its parent according to window-parent
(move/resize-managed child))))))
-
-
-
(defun test-mouse-binding (window root-x root-y)
(dbg window root-x root-y)
(replay-button-event))
@@ -775,8 +768,8 @@ For window: set current child to window or its parent according to window-parent
"Jump to slot"
(let ((jump-child (aref key-slots current-slot)))
(when (find-child jump-child *root-frame*)
- (unless (find-child jump-child *current-root*)
- (setf *current-root* jump-child))
+ (unless (find-child-in-all-root jump-child)
+ (change-root (find-related-root jump-child) jump-child))
(setf *current-child* jump-child)
(focus-all-children *current-child* *current-child*)
(show-all-children t))))
@@ -816,19 +809,19 @@ For window: set current child to window or its parent according to window-parent
;;; Pack
(defun current-frame-pack-up ()
"Pack the current frame up"
- (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-pack-down ()
"Pack the current frame down"
- (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-pack-left ()
"Pack the current frame left"
- (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-pack-right ()
"Pack the current frame right"
- (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
;;; Center
(defun center-current-frame ()
@@ -838,24 +831,24 @@ For window: set current child to window or its parent according to window-parent
;;; Fill
(defun current-frame-fill-up ()
"Fill the current frame up"
- (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-fill-down ()
"Fill the current frame down"
- (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-fill-left ()
"Fill the current frame left"
- (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-fill-right ()
"Fill the current frame right"
- (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* *current-root*))))
+ (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
(defun current-frame-fill-all-dir ()
"Fill the current frame in all directions"
(with-movement
- (let ((parent (find-parent-frame *current-child* *current-root*)))
+ (let ((parent (find-parent-frame *current-child* (find-current-root))))
(fill-frame-up *current-child* parent)
(fill-frame-down *current-child* parent)
(fill-frame-left *current-child* parent)
@@ -864,14 +857,14 @@ For window: set current child to window or its parent according to window-parent
(defun current-frame-fill-vertical ()
"Fill the current frame vertically"
(with-movement
- (let ((parent (find-parent-frame *current-child* *current-root*)))
+ (let ((parent (find-parent-frame *current-child* (find-current-root))))
(fill-frame-up *current-child* parent)
(fill-frame-down *current-child* parent))))
(defun current-frame-fill-horizontal ()
"Fill the current frame horizontally"
(with-movement
- (let ((parent (find-parent-frame *current-child* *current-root*)))
+ (let ((parent (find-parent-frame *current-child* (find-current-root))))
(fill-frame-left *current-child* parent)
(fill-frame-right *current-child* parent))))
@@ -1067,7 +1060,7 @@ For window: set current child to window or its parent according to window-parent
"Move the child under the mouse cursor to another frame"
(declare (ignore window))
(let ((child (find-child-under-mouse root-x root-y)))
- (unless (child-equal-p child *current-root*)
+ (unless (child-root child)
(hide-all child)
(remove-child-in-frame child (find-parent-frame child))
(wait-mouse-button-release 50 51)
@@ -1106,7 +1099,7 @@ For window: set current child to window or its parent according to window-parent
;;; Hide/Unhide current child
(defun hide-current-child ()
"Hide the current child"
- (unless (child-equal-p *current-child* *current-root*)
+ (unless (child-root *current-child*)
(let ((parent (find-parent-frame *current-child*)))
(when (frame-p parent)
(with-slots (child hidden-children) parent
@@ -1183,8 +1176,8 @@ 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
- (setf *current-root* last-child
- *current-child* *current-root*)
+ (change-root (find-related-root last-child) last-child)
+ (setf *current-child* last-child)
(focus-all-children *current-child* *current-child*)
(show-all-children t))
(setf last-child current-child))
@@ -1592,8 +1585,8 @@ For window: set current child to window or its parent according to window-parent
:line-style :solid))
(setf (window-transparency window) *notify-window-transparency*)
(when (frame-p *current-child*)
- (setf current-child *current-child*)
- (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*))
+ (setf current-child *current-child*))
+ (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*)
(map-window window)
(refresh-notify-window)
(xlib:display-finish-output *display*))))))
@@ -1620,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
- (setf *current-root* parent))
+ (change-root (find-related-root parent) parent))
(focus-all-children window parent)
(show-all-children t))
(funcall run-fn))))
@@ -1676,7 +1669,15 @@ For window: set current child to window or its parent according to window-parent
(substitute #\space #\+
(subseq line it (position #\space line :start it))))))
sizes)))
- sizes))
+ sizes
+ '((10 10 500 300) (520 20 480 300) (310 330 600 250))))
+
+(defun add-placed-frame-tmp (frame n)
+ (add-frame (create-frame :x 0.01 :y 0.01 :w 0.4 :h 0.4) frame)
+ (add-frame (create-frame :x 0.55 :y 0.01 :w 0.4 :h 0.4) frame)
+ (add-frame (create-frame :x 0.03 :y 0.5 :w 0.64 :h 0.44) frame)
+ (when (plusp n)
+ (add-placed-frame-tmp (first (frame-child frame)) (1- n))))
(defun place-frames-from-xrandr ()
@@ -1684,14 +1685,20 @@ For window: set current child to window or its parent according to window-parent
(let ((sizes (get-xrandr-connected-size))
(width (xlib:screen-width *screen*))
(height (xlib:screen-height *screen*)))
+ (add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
(loop while (< (length (frame-child *root-frame*)) (length sizes))
- do (add-frame (create-frame) *root-frame*))
+ do (let ((frame (create-frame)))
+ (add-frame frame *root-frame*)
+ (add-placed-frame-tmp frame 2)))
+ (setf *current-child* (first (frame-child *root-frame*)))
(loop for size in sizes
for frame in (frame-child *root-frame*)
- do (setf (frame-w frame) (float (/ (first size) width))
- (frame-h frame) (float (/ (second size) height))
- (frame-x frame) (float (/ (third size) width))
- (frame-y frame) (float (/ (fourth size) height))))))
+ 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)))
+ (define-as-root frame x y w h)))))
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 9aa3844..1df7bf7 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -58,8 +58,8 @@
(xlib:with-state (window)
(when (has-bw value-mask)
(setf (x-drawable-border-width window) border-width))
- (if (find-child window *current-root*)
- (let ((parent (find-parent-frame window *current-root*)))
+ (if (find-child window (find-current-root))
+ (let ((parent (find-parent-frame window (find-current-root))))
(if (and parent (managed-window-p window parent))
(adapt-child-to-parent window parent)
(adjust-from-request)))
@@ -75,7 +75,7 @@
(is-in-current-child-p window))
(raise-window window)
(focus-window window)
- (focus-all-children window (find-parent-frame window *current-root*))))))))))
+ (focus-all-children window (find-parent-frame window (find-current-root)))))))))))
(define-handler main-mode :map-request (window send-event-p)
@@ -121,7 +121,7 @@
(focus-window window)))
(:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child)))
- (unless (or (child-equal-p child *current-root*)
+ (unless (or (child-root child)
(equal (typecase child
(xlib:window parent)
(t child))
@@ -130,7 +130,7 @@
(show-all-children)))))))
(define-handler main-mode :exposure (window)
- (awhen (find-frame-window window *current-root*)
+ (awhen (find-frame-window window)
(display-frame-info it)))
@@ -199,6 +199,9 @@
(clear-timers)
(map-window *no-focus-window*)
(dbg *display*)
+ (dbg (xlib:display-roots *display*))
+ (dbg (xlib:display-plist *display*))
+ (dbg (xlib:query-extension *display* "XINERAMA"))
(setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
:substructure-notify
:property-change
@@ -211,8 +214,8 @@
(xlib:display-force-output *display*)
(setf *child-selection* nil)
(setf *root-frame* (create-frame :name "Root" :number 0)
- *current-root* *root-frame*
- *current-child* *current-root*)
+ *current-root* *root-frame* ;;; PHIL: TO REMOVE
+ *current-child* *root-frame*)
(call-hook *init-hook*)
(process-existing-windows *screen*)
(show-all-children)
diff --git a/src/package.lisp b/src/package.lisp
index 068c09b..b3c82e8 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -51,7 +51,7 @@ It is particulary useful with CLISP/MIT-CLX.")
(defconfig *default-transparency* 0.6 nil
"Default transparency for all windows when in xcompmgr transparency mode")
-(defconfig *show-root-frame-p* nil nil
+(defconfig *show-root-frame-p* t nil
"Show the root frame information or not")
@@ -133,6 +133,8 @@ It is particulary useful with CLISP/MIT-CLX.")
(ry :initarg :ry :accessor frame-ry :initform 0)
(rw :initarg :rw :accessor frame-rw :initform 800)
(rh :initarg :rh :accessor frame-rh :initform 600)
+;; (root :initarg :root :accessor frame-root :initform nil
+;; :documentation "A list a physical coordinates (x y w h) if frame is a root frame. Nil otherwise")
(layout :initarg :layout :accessor frame-layout :initform nil
:documentation "Layout to display windows on a frame")
(nw-hook :initarg :nw-hook :accessor frame-nw-hook :initform nil
@@ -166,7 +168,7 @@ It is particulary useful with CLISP/MIT-CLX.")
(defparameter *root-frame* nil
"Root of the root - ie the root frame")
-(defparameter *current-root* nil
+(defparameter *current-root* nil ;;; PHIL: TO REMOVE
"The current fullscreen maximized child")
(defparameter *current-child* nil
"The current child with the focus")
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 +
TODO | 2 +
clfswm.asd | 2 +-
src/clfswm-circulate-mode.lisp | 16 +-
src/clfswm-corner.lisp | 2 +-
src/clfswm-expose-mode.lisp | 4 +-
src/clfswm-internal.lisp | 284 ++++++++++++++++++++++++++++++----------
src/clfswm-nw-hooks.lisp | 38 +++---
src/clfswm-pack.lisp | 4 +-
src/clfswm-util.lisp | 177 ++++++++++---------------
src/clfswm.lisp | 17 ++-
src/config.lisp | 12 --
src/package.lisp | 5 +-
13 files changed, 338 insertions(+), 230 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list