[clfswm-cvs] r418 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Fri Mar 4 21:18:47 UTC 2011
Author: pbrochard
Date: Fri Mar 4 16:18:47 2011
New Revision: 418
Log:
src/clfswm-internal.lisp (show-all-children): Perform only one recusion on the clfswm tree: calculate geometry and place child in one pass.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-corner.lisp
clfswm/src/clfswm-expose-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Mar 4 16:18:47 2011
@@ -1,3 +1,9 @@
+2011-03-04 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (show-all-children): Perform only one
+ recusion on the clfswm tree: calculate geometry and place child in
+ one pass.
+
2011-03-03 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-internal.lisp (show-all-children): Rethink of display
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Fri Mar 4 16:18:47 2011
@@ -98,9 +98,7 @@
*current-child* (frame-selected-child *circulate-parent*))))
(when frame-is-root?
(setf *current-root* *current-child*))))
- (show-all-children (if frame-is-root?
- *current-child*
- (find-parent-frame *current-child*)))
+ (show-all-children)
(draw-circulate-mode-window)))
(defun reorder-subchild (direction)
@@ -112,7 +110,7 @@
(with-slots (child) selected-child
(let ((elem (first (last child))))
(setf child (cons elem (child-remove elem child)))
- (show-all-children selected-child)
+ (show-all-children)
(draw-circulate-mode-window)))))))
Modified: clfswm/src/clfswm-corner.lisp
==============================================================================
--- clfswm/src/clfswm-corner.lisp (original)
+++ clfswm/src/clfswm-corner.lisp Fri Mar 4 16:18:47 2011
@@ -98,7 +98,7 @@
(focus-window win))
(raise-window win))
(t (hide-window win)
- (show-all-children nil)))
+ (show-all-children)))
win)
Modified: clfswm/src/clfswm-expose-mode.lisp
==============================================================================
--- clfswm/src/clfswm-expose-mode.lisp (original)
+++ clfswm/src/clfswm-expose-mode.lisp Fri Mar 4 16:18:47 2011
@@ -156,7 +156,7 @@
(with-all-frames (first-restore-frame frame)
(setf (frame-data-slot frame :old-layout) (frame-layout frame)
(frame-layout frame) #'tile-space-layout))
- (show-all-children *current-root*)
+ (show-all-children)
(expose-mode-display-accel-windows)
(let ((grab-keyboard-p (xgrab-keyboard-p))
(grab-pointer-p (xgrab-pointer-p)))
@@ -185,7 +185,7 @@
(with-all-frames (first-restore-frame frame)
(setf (frame-layout frame) (frame-data-slot frame :old-layout)
(frame-data-slot frame :old-layout) nil))
- (show-all-children *current-root*)
+ (show-all-children)
(banish-pointer)
(unless grab-keyboard-p
(xungrab-keyboard)
@@ -227,6 +227,6 @@
(unless (child-equal-p *current-child* orig-root)
(hide-all *current-root*)
(setf *current-root* orig-root))
- (show-all-children *current-root*))))
+ (show-all-children))))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Mar 4 16:18:47 2011
@@ -615,7 +615,8 @@
(defmethod set-child-stack-order (window child)
(declare (ignore child))
- (raise-window window))
+ (raise-window window)
+ (xlib:display-finish-output *display*))
@@ -729,33 +730,31 @@
-(defun show-all-children (&optional (display-child *current-child*))
- "Show all children from *current-root*. Start the effective display
-only for display-child and its children"
+(defun show-all-children ()
+ "Show all children from *current-root*."
(let ((geometry-change nil)
(previous nil))
- (labels ((rec-geom (root parent selected-p selected-parent-p)
- (when (adapt-child-to-parent root parent)
+ (labels ((rec (child parent selected-p selected-parent-p)
+ (when (adapt-child-to-parent child parent)
(setf geometry-change t))
- (select-child root (cond ((child-equal-p root *current-child*) t)
- ((and selected-p selected-parent-p) :maybe)
- (t nil)))
- (when (frame-p root)
- (let ((selected-child (frame-selected-child root)))
- (dolist (child (reverse (frame-child root)))
- (rec-geom child root (child-equal-p child selected-child) (and selected-p selected-parent-p))))))
- (rec (child parent n)
+ (select-child child (cond ((child-equal-p child *current-child*) t)
+ ((and selected-p selected-parent-p) :maybe)
+ (t nil)))
(when (frame-p child)
- (dolist (sub-child (frame-child child))
- (rec sub-child child (1+ n))))
+ (let ((selected-child (frame-selected-child child)))
+ (dolist (sub-child (frame-child child))
+ (rec sub-child child (child-equal-p sub-child selected-child) (and selected-p selected-parent-p)))))
(show-child child parent previous)
(setf previous child)))
- (rec-geom *current-root* nil t t)
- (rec display-child nil 0)
+ (rec *current-root* nil t t)
(set-focus-to-current-child)
geometry-change)))
+
+
+
+
(defun hide-all-children (root)
"Hide all root children"
(when (frame-p root)
@@ -850,7 +849,7 @@
"Enter in the selected frame - ie make it the root frame"
(hide-all *current-root*)
(setf *current-root* *current-child*)
- (show-all-children *current-root*))
+ (show-all-children))
(defun leave-frame ()
"Leave the selected frame - ie make its parent the root frame"
@@ -858,7 +857,7 @@
(awhen (find-parent-frame *current-root*)
(when (frame-p it)
(setf *current-root* it)))
- (show-all-children *current-root*))
+ (show-all-children))
;;; Other actions (select-next-child, select-next-brother...) are in
@@ -914,7 +913,7 @@
(hide-all *current-root*)
(setf *current-root* *root-frame*)
(unless show-later
- (show-all-children *current-root*)))
+ (show-all-children)))
(defun switch-and-select-root-frame (&key (show-later nil))
"Switch and select the root frame"
@@ -922,14 +921,14 @@
(setf *current-root* *root-frame*)
(setf *current-child* *current-root*)
(unless show-later
- (show-all-children *current-root*)))
+ (show-all-children)))
(defun toggle-show-root-frame ()
"Show/Hide the root frame"
(hide-all *current-root*)
(setf *show-root-frame-p* (not *show-root-frame-p*))
- (show-all-children *current-root*))
+ (show-all-children))
(defun remove-child-in-frame (child frame)
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Fri Mar 4 16:18:47 2011
@@ -56,7 +56,7 @@
(defun set-layout-once (layout-name)
(set-layout-dont-leave layout-name)
- (show-all-children *current-root*)
+ (show-all-children)
(fixe-real-size-current-child)
(set-layout-dont-leave #'no-layout))
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Fri Mar 4 16:18:47 2011
@@ -164,7 +164,7 @@
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
(default-window-placement new-frame window)
- (show-all-children *current-root*)
+ (show-all-children)
t)))
@@ -207,7 +207,7 @@
(setf *current-child* frame)
(focus-all-children window frame)
(default-window-placement frame window)
- (show-all-children *current-root*)
+ (show-all-children)
t))
;;; Open a new window in a named frame
@@ -254,7 +254,7 @@
(setf *current-child* frame)
(focus-all-children window frame)
(default-window-placement frame window)
- (show-all-children *current-root*))
+ (show-all-children))
(throw 'nw-hook-loop t)))
nil)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Mar 4 16:18:47 2011
@@ -273,7 +273,7 @@
(setf (frame-data-slot *current-child* :unmaximized-coords)
(list x y w h)
x 0 y 0 w 1 h 1))))
- (show-all-children (find-parent-frame *current-child*))
+ (show-all-children)
(leave-second-mode)))
@@ -405,7 +405,7 @@
(focus-all-children frame (or (find-parent-frame frame *current-root*)
(find-parent-frame frame)
*root-frame*))
- (show-all-children *current-root*)))
+ (show-all-children)))
(defun focus-frame-by-name ()
@@ -423,7 +423,7 @@
(defun open-frame-by (frame)
(when (frame-p frame)
(push (create-frame :name (query-string "Frame name")) (frame-child frame))
- (show-all-children *current-root*)))
+ (show-all-children)))
@@ -447,7 +447,7 @@
(when (child-equal-p frame *current-child*)
(setf *current-child* *current-root*))
(remove-child-in-frame frame (find-parent-frame frame)))
- (show-all-children *current-root*))
+ (show-all-children))
(defun delete-frame-by-name ()
@@ -468,7 +468,7 @@
(remove-child-in-frame child (find-parent-frame child))
(pushnew child (frame-child frame-dest))
(focus-all-children child frame-dest)
- (show-all-children *current-root*)))
+ (show-all-children)))
(defun move-current-child-by-name ()
"Move current child in a named frame"
@@ -491,7 +491,7 @@
(hide-all *current-root*)
(pushnew child (frame-child frame-dest))
(focus-all-children child frame-dest)
- (show-all-children *current-root*)))
+ (show-all-children)))
(defun copy-current-child-by-name ()
"Copy current child in a named frame"
@@ -544,7 +544,7 @@
(move-window window orig-x orig-y #'display-frame-info (list frame))
(setf (frame-x frame) (x-px->fl (xlib:drawable-x window) parent)
(frame-y frame) (y-px->fl (xlib:drawable-y window) parent)))
- (show-all-children frame)))
+ (show-all-children)))
(defun resize-frame (frame parent orig-x orig-y)
@@ -554,7 +554,7 @@
(resize-window window orig-x orig-y #'display-frame-info (list frame))
(setf (frame-w frame) (w-px->fl (xlib:drawable-width window) parent)
(frame-h frame) (h-px->fl (xlib:drawable-height window) parent)))
- (show-all-children frame)))
+ (show-all-children)))
@@ -582,13 +582,15 @@
(unless (equal (type-of child) 'frame)
(setf child (find-frame-window child *current-root*)))
(setf parent (find-parent-frame child)))))
+ (when (and child parent
+ (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)))
(when (equal (type-of child) 'frame)
(funcall mouse-fn child parent root-x root-y))
- (when (and child parent (focus-all-children child parent
- (not (and (child-equal-p *current-child* *current-root*)
- (xlib:window-p *current-root*)))))
- (when (show-all-children *current-root*)
- (setf to-replay nil))))
+ (show-all-children))
(if to-replay
(replay-button-event)
(stop-button-event)))))
@@ -630,6 +632,8 @@
(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)
+ (show-all-children)
(typecase child
(xlib:window
(if (managed-window-p child parent)
@@ -638,8 +642,7 @@
((eql mouse-fn #'resize-frame) #'resize-window))
child root-x root-y)))
(frame (funcall mouse-fn child parent root-x root-y)))
- (focus-all-children child parent window-parent)
- (show-all-children *current-root*)))
+ (show-all-children)))
(move/resize-never-managed (child raise-fun)
(funcall raise-fun child)
(funcall (cond ((eql mouse-fn #'move-frame) #'move-window)
@@ -734,7 +737,7 @@
(setf *current-root* jump-child
*current-child* *current-root*)
(focus-all-children *current-child* *current-child*)
- (show-all-children *current-root*))))
+ (show-all-children))))
(defun bind-or-jump (n)
"Bind or jump to a slot (a frame or a window)"
@@ -1026,7 +1029,7 @@
(setf dest (find-parent-frame dest)))
(unless (child-equal-p child dest)
(move-child-to child dest)
- (show-all-children *current-root*))))))
+ (show-all-children))))))
(stop-button-event))
@@ -1037,7 +1040,7 @@
"Hide/show the frame window"
(when (frame-p frame)
(setf (frame-show-window-p *current-child*) value)
- (show-all-children *current-root*))
+ (show-all-children))
(leave-second-mode))
@@ -1135,7 +1138,7 @@
(setf *current-root* last-child
*current-child* *current-root*)
(focus-all-children *current-child* *current-child*)
- (show-all-children *current-root*))
+ (show-all-children))
(setf last-child current-child))))
@@ -1565,7 +1568,7 @@
(when maximized
(setf *current-root* parent))
(focus-all-children window parent)
- (show-all-children *current-root*))
+ (show-all-children))
(funcall run-fn))))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri Mar 4 16:18:47 2011
@@ -209,7 +209,7 @@
*current-child* *current-root*)
(call-hook *init-hook*)
(process-existing-windows *screen*)
- (show-all-children *current-root*)
+ (show-all-children)
(grab-main-keys)
(xlib:display-finish-output *display*))
More information about the clfswm-cvs
mailing list