changeset 2040:aa926beb4caa

(event-modifiers): New function. (eventp): New function.
author Richard M. Stallman <rms@gnu.org>
date Sun, 07 Mar 1993 07:35:57 +0000
parents e062b4567dc6
children ccb75415543a
files lisp/subr.el
diffstat 1 files changed, 36 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/subr.el	Sun Mar 07 07:32:47 1993 +0000
+++ b/lisp/subr.el	Sun Mar 07 07:35:57 1993 +0000
@@ -208,6 +208,42 @@
 			  c)))
 	    (append key nil))))
 
+(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 event-modifiers (event)
+  "Returns a list of symbols representing the modifier keys in event EVENT.
+The elements of the list may include `meta', `control',
+`shift', `hyper', `super', `alt'.
+See also the function `event-modifier-bits'."
+  (let ((type event))
+    (if (listp type)
+	(setq type (car type)))
+    (if (symbolp type)
+	(cdr (get type 'event-symbol-elements))
+      (let ((list nil))
+	(or (zerop (logand type (lsh 1 23)))
+	    (setq list (cons 'meta list)))
+	(or (and (zerop (logand type (lsh 1 22)))
+		 (>= (logand type 127) 32))
+	    (setq list (cons 'control list)))
+	(or (and (zerop (logand type (lsh 1 21)))
+		 (= (logand type 255) (downcase (logand type 255))))
+	    (setq list (cons 'shift list)))
+	(or (zerop (logand type (lsh 1 20)))
+	    (setq list (cons 'hyper list)))
+	(or (zerop (logand type (lsh 1 19)))
+	    (setq list (cons 'super list)))
+	(or (zerop (logand type (lsh 1 18)))
+	    (setq list (cons 'alt list)))
+	list))))
+
 (defmacro save-match-data (&rest body)
   "Execute the BODY forms, restoring the global value of the match data."
   (let ((original (make-symbol "match-data")))