Mercurial > hg > xemacs-beta

comparison lisp/prim/events.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; events.el --- event functions.
2
3 ;;;; Copyright (C) 1996 Ben Wing.
4
5 ;; Maintainer:
6 ;; Keywords: internal
7
8 ;; This file is part of XEmacs.
9
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
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Synched up with: Not in FSF.
25
26 ;;; Code:
27
28
29 (defun event-console (event)
30 "Return the console that EVENT occurred on.
31 This will be nil for some types of events (e.g. eval events)."
32 (cdfw-console (event-channel event)))
33
34 (defun event-device (event)
35 "Return the device that EVENT occurred on.
36 This will be nil for some types of events (e.g. keyboard and eval events)."
37 (dfw-device (event-channel event)))
38
39 (defun event-frame (event)
40 "Return the frame that EVENT occurred on.
41 This will be nil for some types of events (e.g. keyboard and eval events)."
42 (fw-frame (event-channel event)))
43
44 (defun event-buffer (event)
45 "Given a mouse-motion, button-press, or button-release event, return
46 the buffer on which that event occurred. This will be nil for non-mouse
47 events. If event-over-text-area-p is nil, this will also be nil."
48 (let ((window (event-window event)))
49 (and (windowp window) (window-buffer window))))
50
51 (defalias 'allocate-event 'make-event)
52
53 (defun key-press-event-p (obj)
54 "True if OBJ is a key-press event object."
55 (and (event-live-p obj) (eq 'key-press (event-type obj))))
56
57 (defun button-press-event-p (obj)
58 "True if OBJ is a mouse-button-press event object."
59 (and (event-live-p obj) (eq 'button-press (event-type obj))))
60
61 (defun button-release-event-p (obj)
62 "True if OBJ is a mouse-button-release event object."
63 (and (event-live-p obj) (eq 'button-release (event-type obj))))
64
65 (defun button-event-p (obj)
66 "True if OBJ is a button-press or button-release event object."
67 (or (button-press-event-p obj) (button-release-event-p obj)))
68
69 (defun motion-event-p (obj)
70 "True if OBJ is a mouse-motion event object."
71 (and (event-live-p obj) (eq 'motion (event-type obj))))
72
73 (defun mouse-event-p (obj)
74 "True if OBJ is a button-press, button-release, or mouse-motion event object."
75 (or (button-event-p obj) (motion-event-p obj)))
76
77 (defun process-event-p (obj)
78 "True if OBJ is a process-output event object."
79 (and (event-live-p obj) (eq 'process (event-type obj))))
80
81 (defun timeout-event-p (obj)
82 "True if OBJ is a timeout event object."
83 (and (event-live-p obj) (eq 'timeout (event-type obj))))
84
85 (defun eval-event-p (obj)
86 "True if OBJ is an eval event object."
87 (and (event-live-p obj) (eq 'eval (event-type obj))))
88
89 (defun misc-user-event-p (obj)
90 "True if OBJ is a misc-user event object.
91 A misc-user event is a user event that is not a keypress or mouse click;
92 normally this means a menu selection or scrollbar action."
93 (and (event-live-p obj) (eq 'misc-user (event-type obj))))
94
95 ;; You could just as easily use event-glyph but we include this for
96 ;; consistency.
97
98 (defun event-over-glyph-p (event)
99 "Given a mouse-motion, button-press, or button-release event, return
100 t if the event is over a glyph. Otherwise, return nil."
101 (not (null (event-glyph event))))
102
103 (defun keyboard-translate (&rest pairs)
104 "Translate character or keysym FROM to TO at a low level.
105 Multiple FROM-TO pairs may be specified.
106
107 See `keyboard-translate-table' for more information."
108 (while pairs
109 (puthash (car pairs) (car (cdr pairs)) keyboard-translate-table)
110 (setq pairs (cdr (cdr pairs)))))
111
112 (put 'backspace 'ascii-character ?\b)
113 (put 'delete 'ascii-character ?\177)
114 (put 'tab 'ascii-character ?\t)
115 (put 'linefeed 'ascii-character ?\n)
116 (put 'clear 'ascii-character 12)
117 (put 'return 'ascii-character ?\r)
118 (put 'escape 'ascii-character ?\e)
119 (put 'space 'ascii-character ? )
120
121 ;; Do the same voodoo for the keypad keys. I used to bind these to keyboard
122 ;; macros (for instance, kp_0 was bound to "0") so that they would track the
123 ;; bindings of the corresponding keys by default, but that made the display
124 ;; of M-x describe-bindings much harder to read, so now we'll just bind them
125 ;; to self-insert by default. Not a big difference...
126
127 (put 'kp_0 'ascii-character ?0)
128 (put 'kp_1 'ascii-character ?1)
129 (put 'kp_2 'ascii-character ?2)
130 (put 'kp_3 'ascii-character ?3)
131 (put 'kp_4 'ascii-character ?4)
132 (put 'kp_5 'ascii-character ?5)
133 (put 'kp_6 'ascii-character ?6)
134 (put 'kp_7 'ascii-character ?7)
135 (put 'kp_8 'ascii-character ?8)
136 (put 'kp_9 'ascii-character ?9)
137
138 (put 'kp_space 'ascii-character ? )
139 (put 'kp_tab 'ascii-character ?\t)
140 (put 'kp_enter 'ascii-character ?\r)
141 (put 'kp_equal 'ascii-character ?=)
142 (put 'kp_multiply 'ascii-character ?*)
143 (put 'kp_add 'ascii-character ?+)
144 (put 'kp_separator 'ascii-character ?,)
145 (put 'kp_subtract 'ascii-character ?-)
146 (put 'kp_decimal 'ascii-character ?.)
147 (put 'kp_divide 'ascii-character ?/)