Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b1
author cvs
date Mon, 13 Aug 2007 09:36:16 +0200
parents 54cc21c15cbb
children
comparison
equal deleted inserted replaced
148:f659db2a1f73 149:538048ae2ab8
1 ;;; events.el --- event functions. 1 ;;; events.el --- event functions.
2 2
3 ;;;; Copyright (C) 1996 Ben Wing. 3 ;;;; Copyright (C) 1996 Ben Wing.
4 4
5 ;; Maintainer: 5 ;; Maintainer: Martin Buchholz
6 ;; Keywords: internal 6 ;; Keywords: internal event
7 7
8 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
9 9
10 ;; XEmacs is free software; you can redistribute it and/or modify it 10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by 11 ;; under the terms of the GNU General Public License as published by
41 "Return the frame that EVENT occurred on. 41 "Return the frame that EVENT occurred on.
42 This will be nil for some types of events (e.g. keyboard and eval events)." 42 This will be nil for some types of events (e.g. keyboard and eval events)."
43 (fw-frame (event-channel event))) 43 (fw-frame (event-channel event)))
44 44
45 (defun event-buffer (event) 45 (defun event-buffer (event)
46 "Given a mouse-motion, button-press, or button-release event, return 46 "Return the buffer of the window over which mouse event EVENT occurred.
47 the buffer on which that event occurred. This will be nil for non-mouse 47 Return nil unless both (mouse-event-p EVENT) and
48 events. If event-over-text-area-p is nil, this will also be nil." 48 (event-over-text-area-p EVENT) are non-nil."
49 (let ((window (event-window event))) 49 (let ((window (event-window event)))
50 (and (windowp window) (window-buffer window)))) 50 (and (windowp window) (window-buffer window))))
51 51
52 (defalias 'allocate-event 'make-event) 52 (defalias 'allocate-event 'make-event)
53 53
54 (defun key-press-event-p (obj)
55 "True if OBJ is a key-press event object."
56 (and (event-live-p obj) (eq 'key-press (event-type obj))))
57 54
58 (defun button-press-event-p (obj) 55 (defun key-press-event-p (object)
59 "True if OBJ is a mouse-button-press event object." 56 "Return t if OBJECT is a key-press event."
60 (and (event-live-p obj) (eq 'button-press (event-type obj)))) 57 (and (event-live-p object) (eq 'key-press (event-type object))))
61 58
62 (defun button-release-event-p (obj) 59 (defun button-press-event-p (object)
63 "True if OBJ is a mouse-button-release event object." 60 "Return t if OBJECT is a mouse button-press event."
64 (and (event-live-p obj) (eq 'button-release (event-type obj)))) 61 (and (event-live-p object) (eq 'button-press (event-type object))))
65 62
66 (defun button-event-p (obj) 63 (defun button-release-event-p (object)
67 "True if OBJ is a button-press or button-release event object." 64 "Return t if OBJECT is a mouse button-release event."
68 (or (button-press-event-p obj) (button-release-event-p obj))) 65 (and (event-live-p object) (eq 'button-release (event-type object))))
69 66
70 (defun motion-event-p (obj) 67 (defun button-event-p (object)
71 "True if OBJ is a mouse-motion event object." 68 "Return t if OBJECT is a mouse button-press or button-release event."
72 (and (event-live-p obj) (eq 'motion (event-type obj)))) 69 (and (event-live-p object)
70 (memq (event-type object) '(button-press button-release))
71 t))
73 72
74 (defun mouse-event-p (obj) 73 (defun motion-event-p (object)
75 "True if OBJ is a button-press, button-release, or mouse-motion event object." 74 "Return t if OBJECT is a mouse motion event."
76 (or (button-event-p obj) (motion-event-p obj))) 75 (and (event-live-p object) (eq 'motion (event-type object))))
77 76
78 (defun process-event-p (obj) 77 (defun mouse-event-p (object)
79 "True if OBJ is a process-output event object." 78 "Return t if OBJECT is a mouse button-press, button-release or motion event."
80 (and (event-live-p obj) (eq 'process (event-type obj)))) 79 (and (event-live-p object)
80 (memq (event-type object) '(button-press button-release motion))
81 t))
81 82
82 (defun timeout-event-p (obj) 83 (defun process-event-p (object)
83 "True if OBJ is a timeout event object." 84 "Return t if OBJECT is a process-output event."
84 (and (event-live-p obj) (eq 'timeout (event-type obj)))) 85 (and (event-live-p object) (eq 'process (event-type object))))
85 86
86 (defun eval-event-p (obj) 87 (defun timeout-event-p (object)
87 "True if OBJ is an eval event object." 88 "Return t if OBJECT is a timeout event."
88 (and (event-live-p obj) (eq 'eval (event-type obj)))) 89 (and (event-live-p object) (eq 'timeout (event-type object))))
89 90
90 (defun misc-user-event-p (obj) 91 (defun eval-event-p (object)
91 "True if OBJ is a misc-user event object. 92 "Return t if OBJECT is an eval event."
93 (and (event-live-p object) (eq 'eval (event-type object))))
94
95 (defun misc-user-event-p (object)
96 "Return t if OBJECT is a misc-user event.
92 A misc-user event is a user event that is not a keypress or mouse click; 97 A misc-user event is a user event that is not a keypress or mouse click;
93 normally this means a menu selection or scrollbar action." 98 normally this means a menu selection or scrollbar action."
94 (and (event-live-p obj) (eq 'misc-user (event-type obj)))) 99 (and (event-live-p object) (eq 'misc-user (event-type object))))
95 100
96 ;; You could just as easily use event-glyph but we include this for 101 ;; You could just as easily use event-glyph but we include this for
97 ;; consistency. 102 ;; consistency.
98 103
99 (defun event-over-glyph-p (event) 104 (defun event-over-glyph-p (object)
100 "Given a mouse-motion, button-press, or button-release event, return 105 "Return t if OBJECT is a mouse event occurring over a glyph.
101 t if the event is over a glyph. Otherwise, return nil." 106 Mouse events are events of type button-press, button-release or motion."
102 (not (null (event-glyph event)))) 107 (and (event-live-p object) (event-glyph object) t))
103 108
104 (defun keyboard-translate (&rest pairs) 109 (defun keyboard-translate (&rest pairs)
105 "Translate character or keysym FROM to TO at a low level. 110 "Translate character or keysym FROM to TO at a low level.
106 Multiple FROM-TO pairs may be specified. 111 Multiple FROM-TO pairs may be specified.
107 112
108 See `keyboard-translate-table' for more information." 113 See `keyboard-translate-table' for more information."
109 (while pairs 114 (while pairs
110 (puthash (car pairs) (car (cdr pairs)) keyboard-translate-table) 115 (puthash (pop pairs) (pop pairs) keyboard-translate-table)))
111 (setq pairs (cdr (cdr pairs)))))
112 116
113 (put 'backspace 'ascii-character ?\b) 117 (put 'backspace 'ascii-character ?\b)
114 (put 'delete 'ascii-character ?\177) 118 (put 'delete 'ascii-character ?\177)
115 (put 'tab 'ascii-character ?\t) 119 (put 'tab 'ascii-character ?\t)
116 (put 'linefeed 'ascii-character ?\n) 120 (put 'linefeed 'ascii-character ?\n)