keymap.el

来自「A framework written in Java for implemen」· EL 代码 · 共 499 行 · 第 1/2 页

      (and (consp a)
           (symbolp (setq s (car a)))
           (boundp s)
           (symbol-value s)
           ;; indirect-function deals with autoloadable keymaps
           (setq v (indirect-function (cdr a)))
           (setq l (cons v l))))
    (nreverse l)))


;;#### What a crock
(defun define-prefix-command (name &optional mapvar)
  "Define COMMAND as a prefix command.
A new sparse keymap is stored as COMMAND's function definition.
If second optional argument MAPVAR is not specified,
 COMMAND's value (as well as its function definition) is set to the keymap.
If a second optional argument MAPVAR is given and is not `t',
  the map is stored as its value.
Regardless of MAPVAR, COMMAND's function-value is always set to the keymap."
  (let ((map (make-sparse-keymap name)))
    (fset name map)
    (cond ((not mapvar)
           (set name map))
          ((eq mapvar 't)
           )
          (t
           (set mapvar map)))
    name))


;;; Converting vectors of events to a read-equivalent form.
;;; This is used both by call-interactively (for the command history)
;;; and by macros.el (for saving keyboard macros to a file).

;; #### why does (events-to-keys [backspace]) return "\C-h"?
;; BTW, this function is a mess, and macros.el does *not* use it, in
;; spite of the above comment.  `format-kbd-macro' is used to save
;; keyboard macros to a file.
(defun events-to-keys (events &optional no-mice)
 "Given a vector of event objects, returns a vector of key descriptors,
or a string (if they all fit in the ASCII range).
Optional arg NO-MICE means that button events are not allowed."
 (if (and events (symbolp events)) (setq events (vector events)))
 (cond ((stringp events)
        events)
       ((not (vectorp events))
        (signal 'wrong-type-argument (list 'vectorp events)))
       ((let* ((length (length events))
               (string (make-string length 0))
               c ce
               (i 0))
          (while (< i length)
            (setq ce (aref events i))
            (or (eventp ce) (setq ce (character-to-event ce)))
            ;; Normalize `c' to `?c' and `(control k)' to `?\C-k'
            ;; By passing t for the `allow-meta' arg we could get kbd macros
            ;; with meta in them to translate to the string form instead of
            ;; the list/symbol form; but I expect that would cause confusion,
            ;; so let's use the list/symbol form whenever there's
            ;; any ambiguity.
            (setq c (event-to-character ce))
            (if (and c
                     character-set-property
                     (key-press-event-p ce))
                (cond ((symbolp (event-key ce))
                       (if (get (event-key ce) character-set-property)
                           ;; Don't use a string for `backspace' and `tab' to
                           ;;  avoid that unpleasant little ambiguity.
                           (setq c nil)))
                      ((and (= (event-modifier-bits ce) 1) ;control
                            (integerp (event-key ce)))
                       (let* ((te (character-to-event c)))
                         (if (and (symbolp (event-key te))
                                  (get (event-key te) character-set-property))
                             ;; Don't "normalize" (control i) to tab
                             ;;  to avoid the ambiguity in the other direction
                             (setq c nil))
                         (deallocate-event te)))))
            (if c
                (aset string i c)
                (setq i length string nil))
            (setq i (1+ i)))
          string))
       (t
        (let* ((length (length events))
               (new (copy-sequence events))
               event mods key
               (i 0))
          (while (< i length)
            (setq event (aref events i))
            (cond ((key-press-event-p event)
                   (setq mods (event-modifiers event)
                         key (event-key event))
                   (if (numberp key)
                       (setq key (intern (make-string 1 key))))
                   (aset new i (if mods
                                   (nconc mods (cons key nil))
                                   key)))
                  ((misc-user-event-p event)
                   (aset new i (list 'menu-selection
                                     (event-function event)
                                     (event-object event))))
                  ((or (button-press-event-p event)
                       (button-release-event-p event))
                   (if no-mice
                       (error
                         "Mouse events can't be saved in keyboard macros."))
                   (setq mods (event-modifiers event)
                         key (intern (format "button%d%s"
                                             (event-button event)
                                             (if (button-release-event-p event)
                                                 "up" ""))))
                   (aset new i (if mods
                                   (nconc mods (cons key nil))
                                   key)))
                  ((or (and event (symbolp event))
                       (and (consp event) (symbolp (car event))))
                   (aset new i event))
                  (t
                   (signal 'wrong-type-argument (list 'eventp event))))
            (setq i (1+ i)))
          new))))


(defun next-key-event ()
  "Return the next available keyboard event."
  (let (event)
    (while (not (key-press-event-p (setq event (next-command-event))))
      (dispatch-event event))
    event))

(defun key-sequence-list-description (keys)
  "Convert a key sequence KEYS to the full [(modifiers... key)...] form.
Argument KEYS can be in any form accepted by `define-key' function."
  (let ((vec
	  (cond ((vectorp keys)
		 keys)
		((stringp keys)
		 (vconcat keys))
		(t
		 (vector keys))))
	 (event-to-list
	  #'(lambda (ev)
	    (append (event-modifiers ev) (list (event-key ev))))))
    (mapvector
     #'(lambda (key)
       (cond ((key-press-event-p key)
	      (funcall event-to-list key))
	     ((characterp key)
	      (funcall event-to-list (character-to-event key)))
	     ((listp key)
	      key)
	     (t
	      (list key))))
     vec)))


;;; Support keyboard commands to turn on various modifiers.

;;; These functions -- which are not commands -- each add one modifier
;;; to the following event.

(defun event-apply-alt-modifier (ignore-prompt)
  (event-apply-modifier 'alt))
(defun event-apply-super-modifier (ignore-prompt)
  (event-apply-modifier 'super))
(defun event-apply-hyper-modifier (ignore-prompt)
  (event-apply-modifier 'hyper))
(defun event-apply-shift-modifier (ignore-prompt)
  (event-apply-modifier 'shift))
(defun event-apply-control-modifier (ignore-prompt)
  (event-apply-modifier 'control))
(defun event-apply-meta-modifier (ignore-prompt)
  (event-apply-modifier 'meta))

#|
;;; #### `key-translate-map' is ignored for now.
(defun event-apply-modifier (symbol)
  "Return the next key event, with a modifier flag applied.
SYMBOL is the name of this modifier, as a symbol.
`function-key-map' is scanned for prefix bindings."
  (let (events binding)
    ;; read keystrokes scanning `function-key-map'
    (while (keymapp
	    (setq binding
		  (lookup-key
		   function-key-map
		   (vconcat
		    (setq events
			  (append events (list (next-key-event)))))))))
    (if binding				; found a binding
	(progn
	  ;; allow for several modifiers
	  (if (and (symbolp binding) (fboundp binding))
	      (setq binding (funcall binding nil)))
	  (setq events (append binding nil))
	  ;; put remaining keystrokes back into input queue
	  (setq unread-command-events
		(mapcar 'character-to-event (cdr events))))
      (setq unread-command-events (cdr events)))
    ;; add a modifier SYMBOL to the first keystroke or event
    (vector
     (append (list symbol)
	     (delq symbol
		   (aref (key-sequence-list-description (car events)) 0))))))
|#

(defun synthesize-keysym (ignore-prompt)
  "Read a sequence of keys, and returned the corresponding key symbol.
The characters must be from the [-_a-zA-Z0-9].  Reading is terminated
 by RET (which is discarded)."
  (let ((continuep t)
	event char list)
    (while continuep
      (setq event (next-key-event))
      (cond ((and (setq char (event-to-character event))
		  (or (memq char '(?- ?_))
		      (eq ?w (char-syntax char (standard-syntax-table)))))
	     ;; Advance a character.
	     (push char list))
	    ((or (memq char '(?\r ?\n))
		 (memq (event-key event) '(return newline)))
	     ;; Legal termination.
	     (setq continuep nil))
	    (char
	     ;; Illegal character.
	     (error "Illegal character in keysym: %c" char))
	    (t
	     ;; Illegal event.
	     (error "Event has no character equivalent: %s" event))))
    (vector (intern (concat "" (nreverse list))))))

#|
;; This looks dirty.  The following code should maybe go to another
;; file, and `create-console-hook' should maybe default to nil.
(add-hook
 'create-console-hook
 #'(lambda (console)
   (letf (((selected-console) console))
     (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
     (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
     (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
     (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
     (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
     (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
     (define-key function-key-map [?\C-x ?@ ?k] 'synthesize-keysym))))
|#
;;; keymap.el ends here