diff lisp/prim/events.el @ 149:538048ae2ab8 r20-3b1

Import from CVS: tag r20-3b1
author cvs
date Mon, 13 Aug 2007 09:36:16 +0200 (2007-08-13)
parents 54cc21c15cbb
children
line wrap: on
line diff
--- a/lisp/prim/events.el	Mon Aug 13 09:35:15 2007 +0200
+++ b/lisp/prim/events.el	Mon Aug 13 09:36:16 2007 +0200
@@ -2,8 +2,8 @@
 
 ;;;; Copyright (C) 1996 Ben Wing.
 
-;; Maintainer:
-;; Keywords: internal
+;; Maintainer: Martin Buchholz
+;; Keywords: internal event
 
 ;; This file is part of XEmacs.
 
@@ -43,63 +43,68 @@
   (fw-frame (event-channel event)))
 
 (defun event-buffer (event)
-  "Given a mouse-motion, button-press, or button-release event, return
-the buffer on which that event occurred.  This will be nil for non-mouse
-events.  If event-over-text-area-p is nil, this will also be nil."
+  "Return the buffer of the window over which mouse event EVENT occurred.
+Return nil unless both (mouse-event-p EVENT) and
+(event-over-text-area-p EVENT) are non-nil."
   (let ((window (event-window event)))
     (and (windowp window) (window-buffer window))))
 
 (defalias 'allocate-event 'make-event)
 
-(defun key-press-event-p (obj)
-  "True if OBJ is a key-press event object."
-  (and (event-live-p obj) (eq 'key-press (event-type obj))))
 
-(defun button-press-event-p (obj)
-  "True if OBJ is a mouse-button-press event object."
-  (and (event-live-p obj) (eq 'button-press (event-type obj))))
+(defun key-press-event-p (object)
+  "Return t if OBJECT is a key-press event."
+  (and (event-live-p object) (eq 'key-press (event-type object))))
+
+(defun button-press-event-p (object)
+  "Return t if OBJECT is a mouse button-press event."
+  (and (event-live-p object) (eq 'button-press (event-type object))))
 
-(defun button-release-event-p (obj)
-  "True if OBJ is a mouse-button-release event object."
-  (and (event-live-p obj) (eq 'button-release (event-type obj))))
+(defun button-release-event-p (object)
+  "Return t if OBJECT is a mouse button-release event."
+  (and (event-live-p object) (eq 'button-release (event-type object))))
 
-(defun button-event-p (obj)
-  "True if OBJ is a button-press or button-release event object."
-  (or (button-press-event-p obj) (button-release-event-p obj)))
+(defun button-event-p (object)
+  "Return t if OBJECT is a mouse button-press or button-release event."
+  (and (event-live-p object)
+       (memq (event-type object) '(button-press button-release))
+       t))
 
-(defun motion-event-p (obj)
-  "True if OBJ is a mouse-motion event object."
-  (and (event-live-p obj) (eq 'motion (event-type obj))))
+(defun motion-event-p (object)
+  "Return t if OBJECT is a mouse motion event."
+  (and (event-live-p object) (eq 'motion (event-type object))))
 
-(defun mouse-event-p (obj)
- "True if OBJ is a button-press, button-release, or mouse-motion event object."
-  (or (button-event-p obj) (motion-event-p obj)))
+(defun mouse-event-p (object)
+  "Return t if OBJECT is a mouse button-press, button-release or motion event."
+  (and (event-live-p object)
+       (memq (event-type object) '(button-press button-release motion))
+       t))
 
-(defun process-event-p (obj)
-  "True if OBJ is a process-output event object."
-  (and (event-live-p obj) (eq 'process (event-type obj))))
+(defun process-event-p (object)
+  "Return t if OBJECT is a process-output event."
+  (and (event-live-p object) (eq 'process (event-type object))))
 
-(defun timeout-event-p (obj)
-  "True if OBJ is a timeout event object."
-  (and (event-live-p obj) (eq 'timeout (event-type obj))))
+(defun timeout-event-p (object)
+  "Return t if OBJECT is a timeout event."
+  (and (event-live-p object) (eq 'timeout (event-type object))))
 
-(defun eval-event-p (obj)
-  "True if OBJ is an eval event object."
-  (and (event-live-p obj) (eq 'eval (event-type obj))))
+(defun eval-event-p (object)
+  "Return t if OBJECT is an eval event."
+  (and (event-live-p object) (eq 'eval (event-type object))))
 
-(defun misc-user-event-p (obj)
-  "True if OBJ is a misc-user event object.
+(defun misc-user-event-p (object)
+  "Return t if OBJECT is a misc-user event.
 A misc-user event is a user event that is not a keypress or mouse click;
 normally this means a menu selection or scrollbar action."
-  (and (event-live-p obj) (eq 'misc-user (event-type obj))))
+  (and (event-live-p object) (eq 'misc-user (event-type object))))
 
 ;; You could just as easily use event-glyph but we include this for
 ;; consistency.
 
-(defun event-over-glyph-p (event)
-  "Given a mouse-motion, button-press, or button-release event, return
-t if the event is over a glyph.  Otherwise, return nil."
-  (not (null (event-glyph event))))
+(defun event-over-glyph-p (object)
+  "Return t if OBJECT is a mouse event occurring over a glyph.
+Mouse events are events of type button-press, button-release or motion."
+  (and (event-live-p object) (event-glyph object) t))
 
 (defun keyboard-translate (&rest pairs)
   "Translate character or keysym FROM to TO at a low level.
@@ -107,8 +112,7 @@
 
 See `keyboard-translate-table' for more information."
   (while pairs
-    (puthash (car pairs) (car (cdr pairs)) keyboard-translate-table)
-    (setq pairs (cdr (cdr pairs)))))
+    (puthash (pop pairs) (pop pairs) keyboard-translate-table)))
 
 (put 'backspace 'ascii-character ?\b)
 (put 'delete    'ascii-character ?\177)