[clfswm-cvs] r295 - in clfswm: . src

[Philippe Brochard]

Author: pbrochard
Date: Tue Aug 17 08:38:42 2010
New Revision: 295

Log:
src/clfswm-internal.lisp. with-find-in-all-frames: New macro. find-parent-frame, find-frame-window, find-frame-by-name find-frame-by-number: Use with-find-in-all-frames to search in frames in the right order.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Aug 17 08:38:42 2010
@@ -1,5 +1,10 @@
 2010-08-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-internal.lisp (with-find-in-all-frames): New macro.
+	(find-parent-frame, find-frame-window, find-frame-by-name)
+	(find-frame-by-number): Use with-find-in-all-frames to search in
+	frames in the right order.
+
 	* src/clfswm-util.lisp (mouse-click-to-focus-generic): Fix an
 	unwanted flickering with unmanaged windows.
 

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Tue Aug 17 08:38:42 2010
@@ -7,9 +7,7 @@
 ===============
 Should handle these soon.
 
-BUGS: - Focus with multiple copy of the same window fall in the wrong frame.
-
-######Nothing here :)
+Nothing here :)
 
 MAYBE
 =====

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Tue Aug 17 08:38:42 2010
@@ -316,7 +316,6 @@
 
 
 
-
 (defun find-child (to-find root)
   "Find to-find in root or in its children"
   (with-all-children (root child)
@@ -325,34 +324,37 @@
 
 
 
-(defun find-parent-frame (to-find &optional (root *root-frame*))
-  "Return the parent frame of to-find"
-  (with-all-frames (root frame)
-    (when (member to-find (frame-child frame))
-      (return-from find-parent-frame frame))))
-
+(defmacro with-find-in-all-frames (test &optional return-value)
+  `(let (ret)
+     (block return-block
+       (with-all-frames (root frame)
+	 (when ,test
+	   (if first-foundp
+	       (return-from return-block (or ,return-value frame))
+	       (setf ret frame))))
+       (or ,return-value ret))))
 
+(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))))
 
-(defun find-frame-window (window &optional (root *root-frame*))
+(defun find-frame-window (window &optional (root *root-frame*) first-foundp)
   "Return the frame with the window window"
-  (with-all-frames (root frame)
-    (when (xlib:window-equal window (frame-window frame))
-      (return-from find-frame-window frame))))
-
+  (with-find-in-all-frames
+      (xlib:window-equal window (frame-window frame))))
 
-(defun find-frame-by-name (name)
+(defun find-frame-by-name (name &optional (root *root-frame*) first-foundp)
   "Find a frame from its name"
   (when name
-    (with-all-frames (*root-frame* frame)
-      (when (string-equal name (frame-name frame))
-	(return-from find-frame-by-name frame)))))
+    (with-find-in-all-frames
+	(string-equal name (frame-name frame)))))
 
-(defun find-frame-by-number (number)
+(defun find-frame-by-number (number &optional (root *root-frame*) first-foundp)
   "Find a frame from its number"
   (when (numberp number)
-    (with-all-frames (*root-frame* frame)
-      (when (= number (frame-number frame))
-	(return-from find-frame-by-number frame)))))
+    (with-find-in-all-frames
+	(= number (frame-number frame)))))
 
 
 (defun find-child-in-parent (child base)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue Aug 17 08:38:42 2010
@@ -159,7 +159,7 @@
       win)))
 
 
-(defun find-child-under-mouse (x y)
+(defun find-child-under-mouse (x y &optional first-foundp)
   "Return the child under the mouse"
   (with-xlib-protect
     (let ((ret nil))
@@ -167,10 +167,14 @@
 	(when (and (or (managed-window-p child parent) (equal parent *current-child*))
 		   (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
 		   (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
-	  (setf ret child))
+	  (if first-foundp
+	      (return-from find-child-under-mouse child)
+	      (setf ret child)))
 	(when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
 		   (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
-	  (setf ret child)))
+	  (if first-foundp
+	      (return-from find-child-under-mouse child)
+	      (setf ret child))))
       ret)))