A better patch for mouse-drag-window-above

A better patch for mouse-drag-window-above

[Lennart Borgman]

[-- Attachment #1: Type: text/plain, Size: 418 bytes --]

Sorry, but the patch in 
http://lists.gnu.org/archive/html/emacs-devel/2005-11/msg01522.html was 
broken with many "typos". I thought I was testing it but obviously I was 
not. What do I need to do to test it? I was just recompiling the 
function inside emacs with M-C-x.

I have attached a patch that I hope is better, but I have not tested 
this either. I am sending it now so that the old patch does not get used.


[-- Attachment #2: mouse-drag-window-above2.patch --]
[-- Type: text/plain, Size: 1530 bytes --]

Index: lisp/mouse.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mouse.el,v
retrieving revision 1.287
diff -u -r1.287 mouse.el
--- lisp/mouse.el	27 Nov 2005 19:28:58 -0000	1.287
+++ lisp/mouse.el	29 Nov 2005 22:27:26 -0000
@@ -355,14 +355,22 @@
 (defun mouse-drag-window-above (window)
   "Return the (or a) window directly above WINDOW.
 That means one whose bottom edge is at the same height as WINDOW's top edge."
-  (let ((top (nth 1 (window-edges window)))
+  (let ((start-top   (nth 1 (window-edges window)))
+        (start-left  (nth 0 (window-edges window)))
+        (start-right (nth 2 (window-edges window)))
 	(start-window window)
 	above-window)
     (setq window (previous-window window 0))
     (while (and (not above-window) (not (eq window start-window)))
-      (if (= (+ (window-height window) (nth 1 (window-edges window)))
-	     top)
-	  (setq above-window window))
+      (let ((left  (nth 0 (window-edges window)))
+            (right (nth 2 (window-edges window))))
+        (when (and (= (+ (window-height window) (nth 1 (window-edges window)))
+                      start-top)
+                   (or (and (<= left start-left)  (<= start-right right))
+                       (and (<= start-left left)  (<= left start-right))
+                       (and (<= start-left right) (<= right start-right))))
+          (message "here")
+          (setq above-window window)))
       (setq window (previous-window window)))
     above-window))
 

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel