Mercurial > hg > xemacs-beta
annotate lisp/events.el @ 5629:0d05accafc63
Don't lose bits in make_fixnum / make_char_1.
See xemacs-patches message with ID
<CAHCOHQnRTjm6c5gWVO3iizWJ9Jb7GvEyFe3aQ19hAXhcR_mrrA@mail.gmail.com>.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 28 Dec 2011 11:30:47 -0700 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; events.el --- event functions for XEmacs. |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1996-7 Sun Microsystems, Inc. | |
| 5 ;; Copyright (C) 1996 Ben Wing. | |
| 6 | |
| 7 ;; Maintainer: Martin Buchholz | |
| 8 ;; Keywords: internal, event, dumped | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2828
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; This file is dumped with XEmacs. | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 33 | |
| 34 (defun event-console (event) | |
| 35 "Return the console that EVENT occurred on. | |
| 36 This will be nil for some types of events (e.g. eval events)." | |
| 37 (cdfw-console (event-channel event))) | |
| 38 | |
| 39 (defun event-device (event) | |
| 40 "Return the device that EVENT occurred on. | |
| 41 This will be nil for some types of events (e.g. keyboard and eval events)." | |
| 42 (dfw-device (event-channel event))) | |
| 43 | |
| 44 (defun event-frame (event) | |
| 45 "Return the frame that EVENT occurred on. | |
| 46 This will be nil for some types of events (e.g. keyboard and eval events)." | |
| 47 (fw-frame (event-channel event))) | |
| 48 | |
| 49 (defun event-buffer (event) | |
| 50 "Return the buffer of the window over which mouse event EVENT occurred. | |
| 51 Return nil unless both (mouse-event-p EVENT) and | |
| 52 (event-over-text-area-p EVENT) are non-nil." | |
| 53 (let ((window (event-window event))) | |
| 54 (and (windowp window) (window-buffer window)))) | |
| 55 | |
| 56 (defalias 'allocate-event 'make-event) | |
| 57 | |
| 58 | |
| 59 (defun key-press-event-p (object) | |
| 60 "Return t if OBJECT is a key-press event." | |
| 61 (and (event-live-p object) (eq 'key-press (event-type object)))) | |
| 62 | |
| 63 (defun button-press-event-p (object) | |
| 64 "Return t if OBJECT is a mouse button-press event." | |
| 65 (and (event-live-p object) (eq 'button-press (event-type object)))) | |
| 66 | |
| 67 (defun button-release-event-p (object) | |
| 68 "Return t if OBJECT is a mouse button-release event." | |
| 69 (and (event-live-p object) (eq 'button-release (event-type object)))) | |
| 70 | |
| 71 (defun button-event-p (object) | |
| 72 "Return t if OBJECT is a mouse button-press or button-release event." | |
| 73 (and (event-live-p object) | |
| 74 (memq (event-type object) '(button-press button-release)) | |
| 75 t)) | |
| 76 | |
| 77 (defun motion-event-p (object) | |
| 78 "Return t if OBJECT is a mouse motion event." | |
| 79 (and (event-live-p object) (eq 'motion (event-type object)))) | |
| 80 | |
| 81 (defun mouse-event-p (object) | |
| 82 "Return t if OBJECT is a mouse button-press, button-release or motion event." | |
| 83 (and (event-live-p object) | |
| 84 (memq (event-type object) '(button-press button-release motion)) | |
| 85 t)) | |
| 86 | |
| 87 (defun process-event-p (object) | |
| 88 "Return t if OBJECT is a process-output event." | |
| 89 (and (event-live-p object) (eq 'process (event-type object)))) | |
| 90 | |
| 91 (defun timeout-event-p (object) | |
| 92 "Return t if OBJECT is a timeout event." | |
| 93 (and (event-live-p object) (eq 'timeout (event-type object)))) | |
| 94 | |
| 95 (defun eval-event-p (object) | |
| 96 "Return t if OBJECT is an eval event." | |
| 97 (and (event-live-p object) (eq 'eval (event-type object)))) | |
| 98 | |
| 99 (defun misc-user-event-p (object) | |
| 100 "Return t if OBJECT is a misc-user event. | |
| 101 A misc-user event is a user event that is not a keypress or mouse click; | |
| 102 normally this means a menu selection or scrollbar action." | |
| 103 (and (event-live-p object) (eq 'misc-user (event-type object)))) | |
| 104 | |
| 105 ;; You could just as easily use event-glyph but we include this for | |
| 106 ;; consistency. | |
| 107 | |
| 108 (defun event-over-glyph-p (object) | |
| 109 "Return t if OBJECT is a mouse event occurring over a glyph. | |
| 110 Mouse events are events of type button-press, button-release or motion." | |
| 111 (and (event-live-p object) (event-glyph object) t)) | |
| 112 | |
| 113 (defun keyboard-translate (&rest pairs) | |
| 114 "Translate character or keysym FROM to TO at a low level. | |
| 115 Multiple FROM-TO pairs may be specified. | |
| 116 | |
| 117 See `keyboard-translate-table' for more information." | |
| 118 (while pairs | |
| 119 (puthash (pop pairs) (pop pairs) keyboard-translate-table))) | |
| 120 | |
| 2828 | 121 (defun set-character-of-keysym (keysym character) |
| 122 "Make CHARACTER be inserted when KEYSYM is pressed, | |
| 123 and the key has been bound to `self-insert-command'. " | |
| 124 (check-argument-type 'symbolp keysym) | |
| 125 (check-argument-type 'characterp character) | |
| 126 (put keysym 'character-of-keysym character)) | |
| 127 | |
| 128 (defun get-character-of-keysym (keysym) | |
| 129 "Return the character inserted when KEYSYM is pressed, | |
| 130 and the key is bound to `self-insert-command'. " | |
| 131 (check-argument-type 'symbolp keysym) | |
| 132 (event-to-character (make-event 'key-press (list 'key keysym)))) | |
| 133 | |
| 134 ;; We could take the first few of these out by removing the "/* Optimize for | |
| 135 ;; ASCII keysyms */" code in event-Xt.c, and I've a suspicion that may be | |
| 136 ;; the right thing to do anyway. | |
| 137 | |
| 138 (loop for (keysym char) in | |
| 139 '((tab ?\t) | |
| 140 (linefeed ?\n) | |
| 141 (clear ?\014) | |
| 142 (return ?\r) | |
| 143 (escape ?\e) | |
| 144 (space ? ) | |
| 428 | 145 |
| 2828 | 146 ;; Do the same voodoo for the keypad keys. I used to bind these to |
| 147 ;; keyboard macros (for instance, kp-0 was bound to "0") so that they | |
| 148 ;; would track the bindings of the corresponding keys by default, but | |
| 149 ;; that made the display of M-x describe-bindings much harder to read, | |
| 150 ;; so now we'll just bind them to self-insert by default. Not a big | |
| 151 ;; difference... | |
| 428 | 152 |
| 2828 | 153 (kp-0 ?0) |
| 154 (kp-1 ?1) | |
| 155 (kp-2 ?2) | |
| 156 (kp-3 ?3) | |
| 157 (kp-4 ?4) | |
| 158 (kp-5 ?5) | |
| 159 (kp-6 ?6) | |
| 160 (kp-7 ?7) | |
| 161 (kp-8 ?8) | |
| 162 (kp-9 ?9) | |
| 163 | |
| 164 (kp-space ? ) | |
| 165 (kp-tab ?\t) | |
| 166 (kp-enter ?\r) | |
| 167 (kp-equal ?=) | |
| 168 (kp-multiply ?*) | |
| 169 (kp-add ?+) | |
| 170 (kp-separator ?,) | |
| 171 (kp-subtract ?-) | |
| 172 (kp-decimal ?.) | |
| 173 (kp-divide ?/)) | |
| 174 do (set-character-of-keysym keysym char)) | |
| 428 | 175 |
| 176 ;;; events.el ends here |