-;;; 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, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: emulations
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(put 'menu 'event-symbol-elements '(eval))
(put 'timeout 'event-symbol-elements '(eval))
-(defsubst eventp (obj)
- "True if the argument is an event object."
- (or (integerp obj)
- (and (symbolp obj)
- (get obj 'event-symbol-elements))
- (and (consp obj)
- (symbolp (car obj))
- (get (car obj) 'event-symbol-elements))))
-
(defun allocate-event ()
"Returns an empty event structure.
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
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)
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-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
GNU Emacs 19 does not currently generate process-output events."
(eq (car-safe obj) 'process))
-(defun timeout-event-p (obj)
- "True if the argument is a timeout event object.
-GNU Emacs 19 does not currently generate timeout events."
- (eq (car-safe obj) 'timeout))
+(provide 'levents)
+;;; arch-tag: a80c21da-69d7-46de-9cdb-5f68577b5525
;;; levents.el ends here