Merge pull request #175 from death/master

more tolerant window-head (float-window)
stumpwm · Dec 21, 2014 · 5d34bc8 · 5d34bc8
2 parents a6628e5 + bc1eebd
commit 5d34bc8
Showing 1 changed file with 19 additions and 9 deletions.
diff --git a/floating-group.lisp b/floating-group.lisp
@@ -65,15 +65,25 @@
   )
 
 (defmethod window-head ((window float-window))
-  (dolist (head (screen-heads (group-screen (window-group window))))
-    (when (and
-           (>= (window-x window) (frame-x head))
-           (>= (window-y window) (frame-y head))
-           (<= (+ (window-x window) (window-width window))
-               (+ (frame-x head) (frame-width head)))
-           (<= (+ (window-y window) (window-height window))
-               (+ (frame-y head) (frame-height head))))
-      (return head))))
+  (let ((left (window-x window))
+        (right (+ (window-x window) (window-width window)))
+        (top (window-y window))
+        (bottom (+ (window-y window) (window-height window)))
+        (heads (screen-heads (group-screen (window-group window)))))
+    (flet ((within-frame-p (y x head)
+             (and (>= x (frame-x head))
+                  (< x (+ (frame-x head) (frame-width head)))
+                  (>= y (frame-y head))
+                  (< y (+ (frame-y head) (frame-height head))))))
+      (or (find-if (lambda (head)
+                     (or (within-frame-p top left head)
+                         (within-frame-p top right head)
+                         (within-frame-p bottom left head)
+                         (within-frame-p bottom right head)))
+                   heads)
+          ;; Didn't find any head, so give up and return the first one
+          ;; in the list.
+          (first heads)))))
 
 (defmethod window-visible-p ((win float-window))
   (eql (window-state win) +normal-state+))