comparison lisp/simple.el @ 11140:97ed670a6123

(event-apply-modifier): New function. (event-apply-control-modifier, event-apply-meta-modifier) (event-apply-hyper-modifier, event-apply-shift-modifier) (event-apply-alt-modifier, event-apply-super-modifier): New functions, with bindings in function-key-map.

11139:311f3ea4a759

  (select-window (get-buffer-window "*Completions*"))
  (goto-char (point-min))
  (search-forward "\n\n")
  (forward-line 1))

;;;; Keypad support.

;;; Make the keypad keys act like ordinary typing keys.  If people add
;;; bindings for the function key symbols, then those bindings will
;;; override these, so this shouldn't interfere with any existing

11140:97ed670a6123

  (select-window (get-buffer-window "*Completions*"))
  (goto-char (point-min))
  (search-forward "\n\n")
  (forward-line 1))

;; 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)
  (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
  (vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
  (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
  (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
  (vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
  (vector (event-apply-modifier (read-event) 'meta 27 "M-")))

(defun event-apply-modifier (event symbol lshiftby prefix)
  "Apply a modifier flag to event EVENT.
SYMBOL is the name of this modifier, as a symbol.
LSHIFTBY is the numeric value of this modifier, in keyboard events.
PREFIX is the string that represents this modifier in an event type symbol."
  (if (numberp event)
      (cond ((eq symbol 'control)
	     (if (and (< (downcase event) ?z)
		      (> (downcase event) ?a))
		 (- (downcase event) ?a -1)
	       (if (and (< (downcase event) ?Z)
			(> (downcase event) ?A))
		   (- (downcase event) ?A -1)
		 (logior (lsh 1 lshiftby) event))))
	    ((eq symbol 'shift)
	     (if (and (<= (downcase event) ?z)
		      (>= (downcase event) ?a))
		 (upcase event)
	       (logior (lsh 1 lshiftby) event)))
	    (t
	     (logior (lsh 1 lshiftby) event)))
    (if (memq symbol (event-modifiers event))
	event
      (let ((event-type (if (symbolp event) event (car event))))
	(setq event-type (intern (concat prefix (symbol-name event-type))))
	(if (symbolp event)
	    event-type
	  (cons event-type (cdr event)))))))

(define-key function-key-map [?\C-x escape ?h] 'event-apply-hyper-modifier)
(define-key function-key-map [?\C-x escape ?s] 'event-apply-super-modifier)
(define-key function-key-map [?\C-x escape ?m] 'event-apply-meta-modifier)
(define-key function-key-map [?\C-x escape ?a] 'event-apply-alt-modifier)
(define-key function-key-map [?\C-x escape ?S] 'event-apply-shift-modifier)
(define-key function-key-map [?\C-x escape ?c] 'event-apply-control-modifier)

(define-key function-key-map [?\C-x ?\e ?h] 'event-apply-hyper-modifier)
(define-key function-key-map [?\C-x ?\e ?s] 'event-apply-super-modifier)
(define-key function-key-map [?\C-x ?\e ?m] 'event-apply-meta-modifier)
(define-key function-key-map [?\C-x ?\e ?a] 'event-apply-alt-modifier)
(define-key function-key-map [?\C-x ?\e ?S] 'event-apply-shift-modifier)
(define-key function-key-map [?\C-x ?\e ?c] 'event-apply-control-modifier)

;;;; Keypad support.

;;; Make the keypad keys act like ordinary typing keys.  If people add
;;; bindings for the function key symbols, then those bindings will
;;; override these, so this shouldn't interfere with any existing