]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/levents.el
(def-edebug-form-spec): Add obsolescence info and delete redundant message. Doc
[gnu-emacs] / lisp / emacs-lisp / levents.el
index bc5c06c9cbc29b7d6b70effa134de76a85777d0d..87a6725f17199babb781e30b0fcaabae2f27c129 100644 (file)
@@ -1,6 +1,9 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions.
+;;; levents.el --- emulate the Lucid event data type and associated functions
 
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: emulations
 
 ;; This file is part of GNU Emacs.
 
@@ -16,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -73,6 +76,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
@@ -80,8 +98,8 @@ in is the second.  This function contains knowledge about what the codes
 mean -- for example, the number 9 is converted to the character Tab,
 not the distinct character Control-I.
 
-Beware that character-to-event and event-to-character are not strictly 
-inverse functions, since events contain much more information than the 
+Beware that character-to-event and event-to-character are not strictly
+inverse functions, since events contain much more information than the
 ASCII character set can encode."
   ch)
 
@@ -142,6 +160,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))
@@ -156,11 +214,11 @@ In this emulation, it returns nil for non-mouse-related events."
 (defun event-to-character (event &optional lenient)
   "Returns the closest ASCII approximation to the given event object.
 If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its 
+If the second argument is non-nil, then this is lenient in its
 translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no 
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to 
-the same ASCII code as Control-A.)  If the second arg is nil, then nil 
+and will ignore the shift modifier on those characters which have no
+shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
+the same ASCII code as Control-A.)  If the second arg is nil, then nil
 will be returned for events which have no direct ASCII equivalent."
   (if (symbolp event)
       (and lenient
@@ -230,4 +288,7 @@ an existing event object."
 GNU Emacs 19 does not currently generate process-output events."
   (eq (car-safe obj) 'process))
 
+(provide 'levents)
+
+;;; arch-tag: a80c21da-69d7-46de-9cdb-5f68577b5525
 ;;; levents.el ends here