/[cmucl]/src/hemlock/key-event.lisp
ViewVC logotype

Diff of /src/hemlock/key-event.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.11 by ram, Mon Feb 22 14:36:24 1993 UTC revision 1.6 by rtoy, Fri Jun 19 13:27:30 2009 UTC
# Line 3  Line 3 
3  ;;; **********************************************************************  ;;; **********************************************************************
4  ;;; This code was written as part of the CMU Common Lisp project at  ;;; This code was written as part of the CMU Common Lisp project at
5  ;;; Carnegie Mellon University, and has been placed in the public domain.  ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;; If you want to use this code or any part of CMU Common Lisp, please contact  
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.  
6  ;;;  ;;;
7  (ext:file-comment  (ext:file-comment
8    "$Header$")    "$Header$")
# Line 58  Line 56 
56  ;;;  ;;;
57  (defvar *names-to-keysyms*)  (defvar *names-to-keysyms*)
58    
59  (proclaim '(inline name-keysym keysym-names keysym-preferred-name))  (declaim (inline name-keysym keysym-names keysym-preferred-name))
60    
61  (defun name-keysym (name)  (defun name-keysym (name)
62    "This returns the keysym named name.  If name is unknown, this returns nil."    "This returns the keysym named name.  If name is unknown, this returns nil."
# Line 134  Line 132 
132     this signals an error.  Otherwise, this makes a key-event with the keysym     this signals an error.  Otherwise, this makes a key-event with the keysym
133     and bits formed by mapping the X bits to key-event bits.     and bits formed by mapping the X bits to key-event bits.
134    
135       If any state bit is set that has no suitable modifier translation, it is
136       passed to XLIB:DEFAULT-KEYSYM-INDEX in order to handle Mode_Switch keys
137       appropriately.
138    
139     Otherwise, this makes a key-event with the keysym and bits formed by mapping     Otherwise, this makes a key-event with the keysym and bits formed by mapping
140     the X bits to key-event bits."     the X bits to key-event bits."
141    (let ((new-bits 0)    (let ((new-bits 0)
142          shiftp lockp)          shiftp lockp)
143      (dolist (map *modifier-translations*)      (dolist (map *modifier-translations*)
144        (unless (zerop (logand (car map) bits))        (unless (zerop (logand (car map) bits))
145            ;; ignore the bits of the mapping for the determination of a key index
146            (setq bits (logxor bits (car map)))
147          (cond          (cond
148           ((string-equal (cdr map) "Shift")           ((string-equal (cdr map) "Shift")
149            (setf shiftp t))            (setf shiftp t))
# Line 147  Line 151 
151            (setf lockp t))            (setf lockp t))
152           (t (setf new-bits           (t (setf new-bits
153                    (logior new-bits (key-event-modifier-mask (cdr map))))))))                    (logior new-bits (key-event-modifier-mask (cdr map))))))))
154      (let ((keysym (xlib:keycode->keysym display scan-code (if shiftp 1 0))))      ;; here pass any remaining modifier bits to clx
155        (let* ((index  (and (not (zerop bits))
156                            (xlib:default-keysym-index display scan-code bits)))
157               (keysym (xlib:keycode->keysym display scan-code (or index (if shiftp 1 0)))))
158        (cond ((null (keysym-names keysym))        (cond ((null (keysym-names keysym))
159               nil)               nil)
160              ((and (not shiftp) lockp (<= 97 keysym 122)) ; small-alpha-char-p              ((and (not shiftp) lockp (<= 97 keysym 122)) ; small-alpha-char-p
# Line 289  Line 296 
296  ;;; This maps Common Lisp CHAR-CODE's to character classes for parsing #k  ;;; This maps Common Lisp CHAR-CODE's to character classes for parsing #k
297  ;;; syntax.  ;;; syntax.
298  ;;;  ;;;
299  (defvar *key-character-classes* (make-array char-code-limit  (defvar *key-character-classes* (make-array #-unicode char-code-limit #+unicode 256
300                                              :initial-element :other))                                              :initial-element :other))
301    
302  ;;; These characters are special:  ;;; These characters are special:
# Line 733  Line 740 
740    (setf *keysym-high-bytes* (make-array 256 :initial-element nil))    (setf *keysym-high-bytes* (make-array 256 :initial-element nil))
741    (setf *key-event-characters* (make-hash-table))    (setf *key-event-characters* (make-hash-table))
742    (setf *character-key-events*    (setf *character-key-events*
743          (make-array char-code-limit :initial-element nil))          (make-array #-unicode char-code-limit #+unicode 256 :initial-element nil))
744    
745    (define-key-event-modifier "Hyper" "H")    (define-key-event-modifier "Hyper" "H")
746    (define-key-event-modifier "Super" "S")    (define-key-event-modifier "Super" "S")

Legend:
Removed from v.1.1.1.11  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5