From: Richard M. Stallman <rms@gnu.org>
Date: Sat, 17 May 1997 18:38:17 +0000 (+0000)
Subject: (event-closest-point): New function.
X-Git-Tag: emacs-20.1~2087
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4f76fb9ac47f2e8b5259da1677922cb4b96e1e4c;p=emacs.git

(event-closest-point): New function.
(event-closest-point-1): New subroutine.

(mouse-event-p, button-event-p): New functions.
---

diff --git a/lisp/emacs-lisp/levents.el b/lisp/emacs-lisp/levents.el
index bc5c06c9cbc..ed12511f322 100644
--- a/lisp/emacs-lisp/levents.el
+++ b/lisp/emacs-lisp/levents.el
@@ -73,6 +73,21 @@ In this emulation, it returns nil."
        (or (memq 'click (get (car obj) 'event-symbol-elements))
 	   (memq 'drag (get (car obj) 'event-symbol-elements)))))
 
+(defun button-event-p (obj)
+  "True if the argument is a mouse-button press or release event object."
+  (and (consp obj) (symbolp (car obj))
+       (or (memq 'click (get (car obj) 'event-symbol-elements))
+	   (memq 'down (get (car obj) 'event-symbol-elements))
+	   (memq 'drag (get (car obj) 'event-symbol-elements)))))
+
+(defun mouse-event-p (obj)
+  "True if the argument is a mouse-button press or release event object."
+  (and (consp obj) (symbolp (car obj))
+       (or (eq (car obj) 'mouse-movement)
+	   (memq 'click (get (car obj) 'event-symbol-elements))
+	   (memq 'down (get (car obj) 'event-symbol-elements))
+	   (memq 'drag (get (car obj) 'event-symbol-elements)))))
+
 (defun character-to-event (ch &optional event)
   "Converts a numeric ASCII value to an event structure, replete with
 bucky bits.  The character is the first argument, and the event to fill
@@ -142,6 +157,46 @@ not occur over text, then this returns nil.  Otherwise, it returns an index
 into the buffer visible in the event's window."
   (posn-point (event-end event)))
 
+;; Return position of start of line LINE in WINDOW.
+;; If LINE is nil, return the last position
+;; visible in WINDOW.
+(defun event-closest-point-1 (window &optional line)
+  (let* ((total (- (window-height window)
+		   (if (window-minibuffer-p window)
+		       0 1)))
+	 (distance (or line total)))
+    (save-excursion
+      (goto-char (window-start window))
+      (if (= (vertical-motion distance) distance)
+	  (if (not line)
+	      (forward-char -1)))
+      (point))))
+
+(defun event-closest-point (event &optional start-window)
+  "Return the nearest position to where EVENT ended its motion.
+This is computed for the window where EVENT's motion started,
+or for window WINDOW if that is specified."
+  (or start-window (setq start-window (posn-window (event-start event))))
+  (if (eq start-window (posn-window (event-end event)))
+      (if (eq (event-point event) 'vertical-line)
+	  (event-closest-point-1 start-window
+				 (cdr (posn-col-row (event-end event))))
+	(if (eq (event-point event) 'mode-line)
+	    (event-closest-point-1 start-window)
+	  (event-point event)))
+    ;; EVENT ended in some other window.
+    (let* ((end-w (posn-window (event-end event)))
+	   (end-w-top)
+	   (w-top (nth 1 (window-edges start-window))))
+      (setq end-w-top
+	    (if (windowp end-w)
+		(nth 1 (window-edges end-w))
+	      (/ (cdr (posn-x-y (event-end event)))
+		 ((frame-char-height end-w)))))
+      (if (>= end-w-top w-top)
+	  (event-closest-point-1 start-window)
+	(window-start start-window)))))
+
 (defun event-process (event)
   "Returns the process of the given process-output event."
   (nth 1 event))