(edebug-eval-defun): Add `defface'. Fix docstring.

[gnu-emacs] / lisp / emacs-lisp / levents.el

diff --git a/lisp/emacs-lisp/levents.el b/lisp/emacs-lisp/levents.el
index bc5c06c9cbc29b7d6b70effa134de76a85777d0d..cd3fe2764c2a30799fe6f4c8c8153bd2fe934eca 100644 (file)
--- a/lisp/emacs-lisp/levents.el
+++ b/lisp/emacs-lisp/levents.el
@@ -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.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -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)))))
 
        (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
 (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.
 
 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)
 
 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)))
 
 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))
 (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.
 (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,
 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
 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))
 
 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
 ;;; levents.el ends here