[clfswm-cvs] r306 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sun Aug 29 11:47:52 UTC 2010
Author: pbrochard
Date: Sun Aug 29 07:47:52 2010
New Revision: 306
Log:
child-member, child-remove: New predicates. src/*.lisp: Use child-member and child-remove everywhere it's needed.
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 Sun Aug 29 07:47:52 2010
@@ -1,3 +1,11 @@
+2010-08-29 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (child-member): New predicate.
+ (child-remove): New function.
+
+ * src/*.lisp: Use child-member and child-remove everywhere it's
+ needed.
+
2010-08-28 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm.lisp (main-loop): Ensure that all events have been
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Sun Aug 29 07:47:52 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* :test #'child-equal-p)))))
+ (setf child (nconc (list elem) (child-remove elem *circulate-orig*)))))
(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* :test #'child-equal-p))
+ (setf (frame-child *circulate-parent*) (nconc (list elem) (child-remove elem *circulate-orig*))
*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 Sun Aug 29 07:47:52 2010
@@ -88,6 +88,31 @@
+
+(defgeneric child-equal-p (child-1 child-2))
+
+(defmethod child-equal-p ((child-1 xlib:window) (child-2 xlib:window))
+ (xlib:window-equal child-1 child-2))
+
+(defmethod child-equal-p ((child-1 frame) (child-2 frame))
+ (equal child-1 child-2))
+
+(defmethod child-equal-p (child-1 child-2)
+ (declare (ignore child-1 child-2))
+ nil)
+
+
+(declaim (inline child-member child-remove))
+
+(defun child-member (child list)
+ (member child list :test #'child-equal-p))
+
+(defun child-remove (child list)
+ (remove child list :test #'child-equal-p))
+
+
+
+
;;; Frame data manipulation functions
(defun frame-data-slot (frame slot)
"Return the value associated to data slot"
@@ -110,11 +135,11 @@
(if (frame-p frame)
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) frame
- (and (not (member window unmanaged :test #'child-equal-p))
+ (and (not (child-member window unmanaged))
(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 :test #'child-equal-p)
+ (child-member window managed)
(member (xlib:wm-name window) managed :test #'string-equal-p))))
t))
@@ -126,21 +151,6 @@
-
-(defgeneric child-equal-p (child-1 child-2))
-
-(defmethod child-equal-p ((child-1 xlib:window) (child-2 xlib:window))
- (xlib:window-equal child-1 child-2))
-
-(defmethod child-equal-p ((child-1 frame) (child-2 frame))
- (equal child-1 child-2))
-
-(defmethod child-equal-p (child-1 child-2)
- (declare (ignore child-1 child-2))
- nil)
-
-
-
(defgeneric child-name (child))
(defmethod child-name ((child xlib:window))
@@ -202,7 +212,7 @@
(defun is-in-current-child-p (child)
(and (frame-p *current-child*)
- (member child (frame-child *current-child*) :test #'child-equal-p)))
+ (child-member child (frame-child *current-child*))))
@@ -355,7 +365,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) :test #'child-equal-p)))
+ (child-member to-find (frame-child frame))))
(defun find-frame-window (window &optional (root *root-frame*) first-foundp)
"Return the frame with the window window"
@@ -693,10 +703,10 @@
(defun focus-child (child parent)
"Focus child - Return true if something has change"
(when (and (frame-p parent)
- (member child (frame-child parent) :test #'child-equal-p))
+ (child-member child (frame-child parent)))
(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 :test #'child-equal-p))))
+ (setf parent-child (nth-insert selected-pos child (child-remove child parent-child))))
t)))
(defun focus-child-rec (child parent)
@@ -835,7 +845,7 @@
(defun remove-child-in-frame (child frame)
"Remove the child in frame"
(when (frame-p frame)
- (setf (frame-child frame) (remove child (frame-child frame) :test #'child-equal-p))))
+ (setf (frame-child frame) (child-remove child (frame-child frame)))))
(defun remove-child-in-frames (child root)
"Remove child in the frame root and in all its children"
@@ -954,7 +964,7 @@
(let ((id-list nil)
(all-windows (get-all-windows)))
(dolist (win (xlib:query-tree (xlib:screen-root screen)))
- (unless (member win all-windows :test #'child-equal-p)
+ (unless (child-member win all-windows)
(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 Sun Aug 29 07:47:52 2010
@@ -195,10 +195,10 @@
(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 :test #'child-equal-p)
+ (unless (child-member ch managed-children)
(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))
+ (child-member x managed-in-parent))
managed-children))
(setf (frame-data-slot parent :layout-managed-children) managed-children)
managed-children))
@@ -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 :test #'child-equal-p)
+ (if (child-member child main-windows)
(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 :test #'child-equal-p)
+ (if (child-member child main-windows)
(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 :test #'child-equal-p)
+ (if (child-member child main-windows)
(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 :test #'child-equal-p)
+ (if (child-member child main-windows)
(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*) :test #'child-equal-p)
+ (when (child-member window (get-managed-child *current-child*))
(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*) :test #'child-equal-p)
+ (when (child-member window (get-managed-child *current-child*))
(setf (frame-data-slot *current-child* :main-window-list)
- (remove window (frame-data-slot *current-child* :main-window-list) :test #'child-equal-p)))))
+ (child-remove window (frame-data-slot *current-child* :main-window-list))))))
(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 :test #'child-equal-p))
+ (child-member (frame-selected-child *current-child*) main-windows))
(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) :test #'child-equal-p))
+ (child-member window (frame-data-slot *current-child* :main-window-list)))
(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 Sun Aug 29 07:47:52 2010
@@ -971,7 +971,7 @@
(let ((parent (find-parent-frame window)))
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) parent
- (setf unmanaged (remove window unmanaged :test #'child-equal-p)
+ (setf unmanaged (child-remove window unmanaged)
unmanaged (remove (xlib:wm-name window) unmanaged :test #'string-equal-p))
(pushnew window managed))))
(leave-second-mode))
@@ -982,7 +982,7 @@
(let ((parent (find-parent-frame window)))
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) parent
- (setf managed (remove window managed :test #'child-equal-p)
+ (setf managed (child-remove window managed)
managed (remove (xlib:wm-name window) managed :test #'string-equal-p))
(pushnew window unmanaged))))
(leave-second-mode))
@@ -1037,7 +1037,7 @@
(when (frame-p parent)
(with-slots (child hidden-children) parent
(hide-all *current-child*)
- (setf child (remove *current-child* child :test #'child-equal-p))
+ (setf child (child-remove *current-child* child))
(pushnew *current-child* hidden-children)
(setf *current-child* parent))
(show-all-children)))
@@ -1047,7 +1047,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 :test #'child-equal-p)))
+ (setf hidden-children (child-remove hidden hidden-children)))
(with-slots (child) frame-dest
(pushnew hidden child)))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Sun Aug 29 07:47:52 2010
@@ -92,8 +92,7 @@
(not (xlib:window-equal window event-window)))
(when (find-child window *root-frame*)
(delete-child-in-all-frames window)
- (unless (null-size-window-p window)
- (show-all-children)))))
+ (show-all-children))))
(define-handler main-mode :destroy-notify (send-event-p event-window window)
@@ -101,8 +100,7 @@
(xlib:window-equal window event-window))
(when (find-child window *root-frame*)
(delete-child-in-all-frames window)
- (unless (null-size-window-p window)
- (show-all-children)))))
+ (show-all-children))))
(define-handler main-mode :enter-notify (window root-x root-y)
(unless (and (> root-x (- (xlib:screen-width *screen*) 3))
@@ -112,7 +110,7 @@
*default-focus-policy*)
(:sloppy (focus-window window))
(:sloppy-strict (when (and (frame-p *current-child*)
- (member window (frame-child *current-child*) :test #'child-equal-p))
+ (child-member window (frame-child *current-child*)))
(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