[clfswm-cvs] r303 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Fri Aug 27 22:05:52 UTC 2010
Author: pbrochard
Date: Fri Aug 27 18:05:51 2010
New Revision: 303
Log:
main-mode:configure-request: Raise the window only when present on the current child and focus it accordingly.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Aug 27 18:05:51 2010
@@ -1,3 +1,12 @@
+2010-08-28 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (is-in-current-child-p): New function.
+
+2010-08-27 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm.lisp (main-mode:configure-request): Raise the window
+ only when present on the current child and focus it accordingly.
+
2010-08-26 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-circulate-mode.lisp (circulate-loop-function):
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Fri Aug 27 18:05:51 2010
@@ -76,7 +76,7 @@
(let ((len (length *circulate-orig*)))
(when (plusp len)
(let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
- (setf child (nconc (list elem) (remove elem *circulate-orig*)))))
+ (setf child (nconc (list elem) (remove elem *circulate-orig* :test #'child-equal-p)))))
(show-all-children)
(draw-circulate-mode-window))))
@@ -94,7 +94,7 @@
(when (plusp len)
(when (frame-p *circulate-parent*)
(let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
- (setf (frame-child *circulate-parent*) (nconc (list elem) (remove elem *circulate-orig*))
+ (setf (frame-child *circulate-parent*) (nconc (list elem) (remove elem *circulate-orig* :test #'child-equal-p))
*current-child* (frame-selected-child *circulate-parent*))))
(when frame-is-root?
(setf *current-root* *current-child*))))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Aug 27 18:05:51 2010
@@ -110,11 +110,11 @@
(if (frame-p frame)
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) frame
- (and (not (member window unmanaged))
+ (and (not (member window unmanaged :test #'child-equal-p))
(not (member (xlib:wm-name window) unmanaged :test #'string-equal-p))
(or (member :all (frame-managed-type frame))
(member (window-type window) (frame-managed-type frame))
- (member window managed)
+ (member window managed :test #'child-equal-p)
(member (xlib:wm-name window) managed :test #'string-equal-p))))
t))
@@ -200,6 +200,11 @@
(declare (ignore child name)))
+(defun is-in-current-child-p (child)
+ (and (frame-p *current-child*)
+ (member child (frame-child *current-child*) :test #'child-equal-p)))
+
+
;; (with-all-children (*root-frame* child) (typecase child (xlib:window (print child)) (frame (print (frame-number child)))))
(defmacro with-all-children ((root child) &body body)
@@ -350,7 +355,7 @@
(defun find-parent-frame (to-find &optional (root *root-frame*) first-foundp)
"Return the parent frame of to-find"
(with-find-in-all-frames
- (member to-find (frame-child frame))))
+ (member to-find (frame-child frame) :test #'child-equal-p)))
(defun find-frame-window (window &optional (root *root-frame*) first-foundp)
"Return the frame with the window window"
@@ -688,10 +693,10 @@
(defun focus-child (child parent)
"Focus child - Return true if something has change"
(when (and (frame-p parent)
- (member child (frame-child parent)))
+ (member child (frame-child parent) :test #'child-equal-p))
(when (not (child-equal-p child (frame-selected-child parent)))
(with-slots ((parent-child child) selected-pos) parent
- (setf parent-child (nth-insert selected-pos child (remove child parent-child))))
+ (setf parent-child (nth-insert selected-pos child (remove child parent-child :test #'child-equal-p))))
t)))
(defun focus-child-rec (child parent)
@@ -949,7 +954,7 @@
(let ((id-list nil)
(all-windows (get-all-windows)))
(dolist (win (xlib:query-tree (xlib:screen-root screen)))
- (unless (member win all-windows)
+ (unless (member win all-windows :test #'child-equal-p)
(let ((map-state (xlib:window-map-state win))
(wm-state (window-state win)))
(unless (or (eql (xlib:window-override-redirect win) :on)
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Fri Aug 27 18:05:51 2010
@@ -195,7 +195,7 @@
(let ((managed-children (frame-data-slot parent :layout-managed-children))
(managed-in-parent (get-managed-child parent)))
(dolist (ch managed-in-parent)
- (unless (member ch managed-children)
+ (unless (member ch managed-children :test #'child-equal-p)
(setf managed-children (append managed-children (list child)))))
(setf managed-children (remove-if-not (lambda (x)
(member x managed-in-parent :test #'child-equal-p))
@@ -515,7 +515,7 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (zerop len)
(no-layout child parent)
- (if (member child main-windows)
+ (if (member child main-windows :test #'child-equal-p)
(let* ((dy (/ rh len))
(pos (position child main-windows)))
(values (1+ (round (+ rx (* rw (- 1 size)))))
@@ -543,7 +543,7 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (zerop len)
(no-layout child parent)
- (if (member child main-windows)
+ (if (member child main-windows :test #'child-equal-p)
(let* ((dy (/ rh len))
(pos (position child main-windows)))
(values (1+ rx)
@@ -570,7 +570,7 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (zerop len)
(no-layout child parent)
- (if (member child main-windows)
+ (if (member child main-windows :test #'child-equal-p)
(let* ((dx (/ rw len))
(pos (position child main-windows)))
(values (1+ (round (+ rx (* dx pos))))
@@ -597,7 +597,7 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (zerop len)
(no-layout child parent)
- (if (member child main-windows)
+ (if (member child main-windows :test #'child-equal-p)
(let* ((dx (/ rw len))
(pos (position child main-windows)))
(values (1+ (round (+ rx (* dx pos))))
@@ -622,7 +622,7 @@
"Add the current window in the main window list"
(when (frame-p *current-child*)
(with-current-window
- (when (member window (get-managed-child *current-child*))
+ (when (member window (get-managed-child *current-child*) :test #'child-equal-p)
(pushnew window (frame-data-slot *current-child* :main-window-list)))))
(leave-second-mode))
@@ -631,9 +631,9 @@
"Remove the current window from the main window list"
(when (frame-p *current-child*)
(with-current-window
- (when (member window (get-managed-child *current-child*))
+ (when (member window (get-managed-child *current-child*) :test #'child-equal-p)
(setf (frame-data-slot *current-child* :main-window-list)
- (remove window (frame-data-slot *current-child* :main-window-list))))))
+ (remove window (frame-data-slot *current-child* :main-window-list) :test #'child-equal-p)))))
(leave-second-mode))
(defun clear-main-window-list ()
@@ -667,7 +667,7 @@
(labels ((rec ()
(setf child (funcall fun-rotate child))
(when (and to-skip?
- (member (frame-selected-child *current-child*) main-windows))
+ (member (frame-selected-child *current-child*) main-windows :test #'child-equal-p))
(rec))))
(unselect-all-frames)
(rec)
@@ -688,7 +688,7 @@
Or do actions on corners - Skip windows in main window list"
(unless (do-corner-action root-x root-y *corner-main-mode-left-button*)
(if (and (frame-p *current-child*)
- (member window (frame-data-slot *current-child* :main-window-list)))
+ (member window (frame-data-slot *current-child* :main-window-list) :test #'child-equal-p))
(replay-button-event)
(mouse-click-to-focus-generic window root-x root-y #'move-frame))))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Aug 27 18:05:51 2010
@@ -970,7 +970,7 @@
(let ((parent (find-parent-frame window)))
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) parent
- (setf unmanaged (remove window unmanaged)
+ (setf unmanaged (remove window unmanaged :test #'child-equal-p)
unmanaged (remove (xlib:wm-name window) unmanaged :test #'string-equal-p))
(pushnew window managed))))
(leave-second-mode))
@@ -981,7 +981,7 @@
(let ((parent (find-parent-frame window)))
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) parent
- (setf managed (remove window managed)
+ (setf managed (remove window managed :test #'child-equal-p)
managed (remove (xlib:wm-name window) managed :test #'string-equal-p))
(pushnew window unmanaged))))
(leave-second-mode))
@@ -1036,7 +1036,7 @@
(when (frame-p parent)
(with-slots (child hidden-children) parent
(hide-all *current-child*)
- (setf child (remove *current-child* child))
+ (setf child (remove *current-child* child :test #'child-equal-p))
(pushnew *current-child* hidden-children)
(setf *current-child* parent))
(show-all-children)))
@@ -1046,7 +1046,7 @@
(defun frame-unhide-child (hidden frame-src frame-dest)
"Unhide a hidden child from frame-src in frame-dest"
(with-slots (hidden-children) frame-src
- (setf hidden-children (remove hidden hidden-children)))
+ (setf hidden-children (remove hidden hidden-children :test #'child-equal-p)))
(with-slots (child) frame-dest
(pushnew hidden child)))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri Aug 27 18:05:51 2010
@@ -70,7 +70,13 @@
(xlib:drawable-border-width window))
(when (has-stackmode value-mask)
(case stack-mode
- (:above (raise-window window))))))))
+ (:above
+ (when (or (child-equal-p window *current-child*)
+ (is-in-current-child-p window))
+ (raise-window window)
+ (focus-window window)
+ (focus-all-children window (find-parent-frame window *current-root*))))))))))
+
(define-handler main-mode :map-request (window send-event-p)
(unless send-event-p
@@ -103,7 +109,7 @@
*default-focus-policy*)
(:sloppy (focus-window window))
(:sloppy-strict (when (and (frame-p *current-child*)
- (member window (frame-child *current-child*)))
+ (member window (frame-child *current-child*) :test #'child-equal-p))
(focus-window window)))
(:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child)))
More information about the clfswm-cvs
mailing list