Use children position information from show-all-children instead of recalculating...

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index e0be9f6..e543dc0 100644 (file)
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -126,6 +126,7 @@
                 (x-drawable-x window) (x-drawable-y window)
                 (x-drawable-width window) (x-drawable-height window))))
 
+
 (defgeneric in-child (child x y))
 
 (defmethod in-child ((child frame) x y)
@@ -1193,78 +1194,82 @@ XINERAMA version 1.1 opcode: 150
 
 
 
-
-(defun show-all-children (&optional (from-root-frame nil))
-  "Show all children and hide those not in a root frame"
-  (declare (ignore from-root-frame))
-  (let ((geometry-change nil)
-        (displayed-child nil)
-        (hidden-child nil))
-    (labels ((in-displayed-list (child)
-               (member child displayed-child :test (lambda (c rect)
-                                                     (child-equal-p c (child-rect-child rect)))))
-
-             (add-in-hidden-list (child)
-               (pushnew child hidden-child :test #'child-equal-p))
-
-             (set-geometry (child parent in-current-root child-current-root-p)
-               (if (or in-current-root child-current-root-p)
+(let ((displayed-child nil))
+  (defun get-displayed-child ()
+    displayed-child)
+
+  (defun show-all-children (&optional (from-root-frame nil))
+    "Show all children and hide those not in a root frame"
+    (declare (ignore from-root-frame))
+    (let ((geometry-change nil)
+          (hidden-child nil))
+      (labels ((in-displayed-list (child)
+                 (member child displayed-child :test (lambda (c rect)
+                                                       (child-equal-p c (child-rect-child rect)))))
+
+               (add-in-hidden-list (child)
+                 (pushnew child hidden-child :test #'child-equal-p))
+
+               (set-geometry (child parent in-current-root child-current-root-p)
+                 (if (or in-current-root child-current-root-p)
+                     (when (frame-p child)
+                       (adapt-frame-to-parent child (if child-current-root-p nil parent)))
+                     (add-in-hidden-list child)))
+
+               (recurse-on-frame-child (child in-current-root child-current-root-p selected-p)
+                 (let ((selected-child (frame-selected-child child)))
+                   (dolist (sub-child (frame-child child))
+                     (rec sub-child child
+                          (and selected-p (child-equal-p sub-child selected-child))
+                          (or in-current-root child-current-root-p)))))
+
+               (hidden-child-p (rect)
+                 (dolist (r displayed-child)
+                   (when (and (rect-hidden-p r rect)
+                              (or (not (xlib:window-p (child-rect-child r)))
+                                  (eq (window-type (child-rect-child r)) :normal)))
+                     (return t))))
+
+               (select-and-display (child parent selected-p)
+                 (multiple-value-bind (nx ny nw nh)
+                     (get-parent-layout child parent)
+                   (let ((rect (make-child-rect :child child :parent parent
+                                                :selected-p selected-p
+                                                :x nx :y ny :w nw :h nh)))
+                     (if (and *show-hide-policy* (hidden-child-p rect))
+                         (add-in-hidden-list child)
+                         (push rect displayed-child)))))
+
+               (display-displayed-child ()
+                 (let ((previous nil))
+                   (setf displayed-child (nreverse displayed-child))
+                   (dolist (rect displayed-child)
+                     (when (adapt-child-to-rect rect)
+                       (setf geometry-change t))
+                     (select-child (child-rect-child rect) (child-rect-selected-p rect))
+                     (show-child (child-rect-child rect)
+                                 (child-rect-parent rect)
+                                 previous)
+                     (setf previous (child-rect-child rect)))))
+
+               (rec (child parent selected-p in-current-root)
+                 (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)
-                     (adapt-frame-to-parent child (if child-current-root-p nil parent)))
-                   (add-in-hidden-list child)))
-
-             (recurse-on-frame-child (child in-current-root child-current-root-p selected-p)
-               (let ((selected-child (frame-selected-child child)))
-                 (dolist (sub-child (frame-child child))
-                   (rec sub-child child
-                        (and selected-p (child-equal-p sub-child selected-child))
-                        (or in-current-root child-current-root-p)))))
-
-             (hidden-child-p (rect)
-               (dolist (r displayed-child)
-                 (when (and (rect-hidden-p r rect)
-                            (or (not (xlib:window-p (child-rect-child r)))
-                                (eq (window-type (child-rect-child r)) :normal)))
-                   (return t))))
-
-             (select-and-display (child parent selected-p)
-               (multiple-value-bind (nx ny nw nh)
-                   (get-parent-layout child parent)
-                 (let ((rect (make-child-rect :child child :parent parent
-                                              :selected-p selected-p
-                                              :x nx :y ny :w nw :h nh)))
-                   (if (and *show-hide-policy* (hidden-child-p rect))
-                       (add-in-hidden-list child)
-                       (push rect displayed-child)))))
-
-             (display-displayed-child ()
-               (let ((previous nil))
-                 (dolist (rect (nreverse displayed-child))
-                   (when (adapt-child-to-rect rect)
-                     (setf geometry-change t))
-                   (select-child (child-rect-child rect) (child-rect-selected-p rect))
-                   (show-child (child-rect-child rect)
-                               (child-rect-parent rect)
-                               previous)
-                   (setf previous (child-rect-child rect)))))
-
-             (rec (child parent selected-p in-current-root)
-               (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)
-                   (recurse-on-frame-child child in-current-root child-current-root-p selected-p))
-                 (when (and (or in-current-root child-current-root-p)
-                            (not (in-displayed-list child)))
-                   (select-and-display child parent selected-p)))))
-
-      (rec *root-frame* nil t (child-root-p *root-frame*))
-      (display-displayed-child)
-      (dolist (child hidden-child)
-        (hide-child child))
-      (set-focus-to-current-child)
-      (xlib:display-finish-output *display*)
-      geometry-change)))
+                     (recurse-on-frame-child child in-current-root child-current-root-p selected-p))
+                   (when (and (or in-current-root child-current-root-p)
+                              (not (in-displayed-list child)))
+                     (select-and-display child parent selected-p)))))
+
+        (setf displayed-child nil)
+        (rec *root-frame* nil t (child-root-p *root-frame*))
+        (display-displayed-child)
+        (dolist (child hidden-child)
+          (hide-child child))
+        (set-focus-to-current-child)
+        (xlib:display-finish-output *display*)
+        geometry-change))))
 
 
 

diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 73834b8..8bc8b62 100644 (file)
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -354,22 +354,6 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
 
 
 
-(defun find-window-under-mouse (x y)
-  "Return the child window under the mouse"
-  (let ((win *root*))
-    (with-all-root-child (root)
-      (with-all-windows-frames-and-parent (root 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)
-          (setf win (frame-window child)))))
-    win))
-
-
-
-
 (defun find-child-under-mouse-in-never-managed-windows (x y)
   "Return the child under mouse from never managed windows"
   (let ((ret nil))
@@ -381,30 +365,20 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
            (setf ret win)))))
     ret))
 
+(defun find-child-under-mouse-in-child-tree (x y)
+  (dolist (child-rect (get-displayed-child))
+    (when (in-rect x y (child-rect-x child-rect) (child-rect-y child-rect)
+                   (child-rect-w child-rect) (child-rect-h child-rect))
+      (return-from find-child-under-mouse-in-child-tree (child-rect-child child-rect)))))
 
-(defun find-child-under-mouse-in-child-tree (x y &optional first-foundp)
-  "Return the child under the mouse"
-  (let ((ret nil))
-    (with-all-root-child (root)
-      (with-all-windows-frames (root child)
-        (when (and (not (window-hidden-p child))
-                   (in-window child x y))
-          (if first-foundp
-              (return-from find-child-under-mouse-in-child-tree child)
-              (setf ret child)))
-        (when (in-frame child x y)
-          (if first-foundp
-              (return-from find-child-under-mouse-in-child-tree child)
-              (setf ret child)))))
-    ret))
 
 
-
-(defun find-child-under-mouse (x y &optional first-foundp also-never-managed)
+(defun find-child-under-mouse (x y &optional also-never-managed)
   "Return the child under the mouse"
   (or (and also-never-managed
           (find-child-under-mouse-in-never-managed-windows x y))
-      (find-child-under-mouse-in-child-tree x y first-foundp)))
+      (find-child-under-mouse-in-child-tree x y)))
+
 
 
 
@@ -593,32 +567,32 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
     "Eval a lisp form from the query input"
     (let ((form (query-string (format nil "Eval Lisp <~A> " (package-name *package*))
                               "" all-symbols))
-            (result nil))
-        (when (and form (not (equal form "")))
-          (let ((printed-result
-                 (with-output-to-string (*standard-output*)
-                   (setf result (handler-case
-                                    (loop for i in (multiple-value-list
-                                                    (eval (read-from-string form)))
-                                       collect (format nil "~S" i))
-                                  (error (condition)
-                                    (format nil "~A" condition)))))))
-            (let ((ret (info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
-                                                          (ensure-list printed-result)
-                                                          (ensure-list result)))
-                                  :width (- (xlib:screen-width *screen*) 2))))
-              (when (or (search "defparameter" form :test #'string-equal)
-                        (search "defvar" form :test #'string-equal))
-                (let ((elem (split-string form)))
-                  (pushnew (string-downcase (if (string= (first elem) "(") (third elem) (second elem)))
-                           all-symbols :test #'string=)))
-              (when (search "in-package" form :test #'string-equal)
-                (let ((*notify-window-placement* 'middle-middle-root-placement))
-                  (open-notify-window '("Collecting all symbols for Lisp REPL completion."))
-                  (setf all-symbols (collect-all-symbols))
-                  (close-notify-window)))
-              (when ret
-                (eval-from-query-string))))))))
+          (result nil))
+      (when (and form (not (equal form "")))
+        (let ((printed-result
+               (with-output-to-string (*standard-output*)
+                 (setf result (handler-case
+                                  (loop for i in (multiple-value-list
+                                                  (eval (read-from-string form)))
+                                     collect (format nil "~S" i))
+                                (error (condition)
+                                  (format nil "~A" condition)))))))
+          (let ((ret (info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
+                                                        (ensure-list printed-result)
+                                                        (ensure-list result)))
+                                :width (- (xlib:screen-width *screen*) 2))))
+            (when (or (search "defparameter" form :test #'string-equal)
+                      (search "defvar" form :test #'string-equal))
+              (let ((elem (split-string form)))
+                (pushnew (string-downcase (if (string= (first elem) "(") (third elem) (second elem)))
+                         all-symbols :test #'string=)))
+            (when (search "in-package" form :test #'string-equal)
+              (let ((*notify-window-placement* 'middle-middle-root-placement))
+                (open-notify-window '("Collecting all symbols for Lisp REPL completion."))
+                (setf all-symbols (collect-all-symbols))
+                (close-notify-window)))
+            (when ret
+              (eval-from-query-string))))))))
 
 
 
@@ -891,7 +865,7 @@ For window: set current child to window or its parent according to window-parent
             (funcall (cond ((eql mouse-fn #'move-frame) #'move-window)
                            ((eql mouse-fn #'resize-frame) #'resize-window))
                      child root-x root-y)))
-    (let ((child (find-child-under-mouse root-x root-y nil t)))
+    (let ((child (find-child-under-mouse root-x root-y t)))
       (multiple-value-bind (never-managed raise-fun)
          (never-managed-window-p child)
        (if (and (xlib:window-p child) never-managed raise-fun)
@@ -1214,11 +1188,11 @@ For window: set current child to window or its parent according to window-parent
   (with-current-window
     (let ((parent (find-parent-frame window)))
       (setf (x-drawable-x window) (truncate (+ (frame-rx parent)
-                                                 (/ (- (frame-rw parent)
-                                                       (x-drawable-width window)) 2)))
+                                               (/ (- (frame-rw parent)
+                                                     (x-drawable-width window)) 2)))
            (x-drawable-y window) (truncate (+ (frame-ry parent)
-                                                 (/ (- (frame-rh parent)
-                                                       (x-drawable-height window)) 2))))
+                                               (/ (- (frame-rh parent)
+                                                     (x-drawable-height window)) 2))))
       (xlib:display-finish-output *display*)))
   (leave-second-mode))
 
@@ -1238,7 +1212,7 @@ For window: set current child to window or its parent according to window-parent
 (defun set-current-window-transparency ()
   "Set the current window transparency"
   (with-current-window
-      (ask-child-transparency "window" window))
+    (ask-child-transparency "window" window))
   (leave-second-mode))
 
 
@@ -1421,7 +1395,7 @@ For window: set current child to window or its parent according to window-parent
 
 (defun current-frame-set-sloppy-select-policy ()
   "Set a sloppy select policy for the current frame."
-    (set-focus-policy-generic :sloppy-select))
+  (set-focus-policy-generic :sloppy-select))
 
 
 
@@ -1445,7 +1419,7 @@ For window: set current child to window or its parent according to window-parent
 
 (defun all-frames-set-sloppy-select-policy ()
   "Set a sloppy select policy for all frames."
-    (set-focus-policy-generic-for-all :sloppy-select))
+  (set-focus-policy-generic-for-all :sloppy-select))
 
 
 
@@ -1518,23 +1492,23 @@ For window: set current child to window or its parent according to window-parent
        (loop for line = (ignore-errors (read-line stream nil nil))
           while line
           do
-          (cond ((first-position "Name=" line) (setf name (um-extract-value line)))
-                ((first-position "Exec=" line) (setf exec (um-extract-value line)))
-                ((first-position "Categories=" line) (setf categories (um-extract-value line)))
-                ((first-position "Comment=" line) (setf comment (um-extract-value line))))
-          (when (and name exec categories)
-            (let* ((sub-menu (um-find-submenu menu (split-string categories #\;)))
-                   (fun-name (intern name :clfswm)))
-              (setf (symbol-function fun-name) (let ((do-exec exec))
-                                                 (lambda ()
-                                                   (do-shell do-exec)
-                                                   (leave-second-mode)))
-                    (documentation fun-name 'function) (format nil "~A~A" name (if comment
-                                                                                   (format nil " - ~A" comment)
-                                                                                   "")))
-              (dolist (m sub-menu)
-                (add-menu-key (menu-name m) :next fun-name m)))
-            (setf name nil exec nil categories nil comment nil)))))))
+             (cond ((first-position "Name=" line) (setf name (um-extract-value line)))
+                   ((first-position "Exec=" line) (setf exec (um-extract-value line)))
+                   ((first-position "Categories=" line) (setf categories (um-extract-value line)))
+                   ((first-position "Comment=" line) (setf comment (um-extract-value line))))
+             (when (and name exec categories)
+               (let* ((sub-menu (um-find-submenu menu (split-string categories #\;)))
+                      (fun-name (intern name :clfswm)))
+                 (setf (symbol-function fun-name) (let ((do-exec exec))
+                                                    (lambda ()
+                                                      (do-shell do-exec)
+                                                      (leave-second-mode)))
+                       (documentation fun-name 'function) (format nil "~A~A" name (if comment
+                                                                                      (format nil " - ~A" comment)
+                                                                                      "")))
+                 (dolist (m sub-menu)
+                   (add-menu-key (menu-name m) :next fun-name m)))
+               (setf name nil exec nil categories nil comment nil)))))))
 
 
 (defun update-menus (&optional (menu (make-menu :name 'main :doc "Main menu")))
@@ -1862,12 +1836,12 @@ For window: set current child to window or its parent according to window-parent
 (defun key-inc-transparency ()
   "Increment the current window transparency"
   (with-current-window
-      (incf (child-transparency window) 0.1)))
+    (incf (child-transparency window) 0.1)))
 
 (defun key-dec-transparency ()
   "Decrement the current window transparency"
   (with-current-window
-      (decf (child-transparency window) 0.1)))
+    (decf (child-transparency window) 0.1)))
 
 
 

diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 730d5d8..62cdf76 100644 (file)
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -79,9 +79,9 @@
                (when (or (child-equal-p window (current-child))
                          (is-in-current-child-p window))
                  (setf change (or change :moved))
-                 (show-all-children)
                  (focus-window window)
-                 (focus-all-children window (find-parent-frame window (find-current-root))))))))
+                 (focus-all-children window (find-parent-frame window (find-current-root)))
+                 (show-all-children))))))
         (unless (eq change :resized)
           ;; To be ICCCM compliant, send a fake configuration notify event only when
           ;; the window has moved and not when it has been resized or the border width has changed.