Mercurial > emacs
diff 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.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 28 Mar 1995 03:49:39 +0000 |
parents | c5fbb6f272f2 |
children | edf66df6fbe9 |
line wrap: on
line diff
--- a/lisp/simple.el Mon Mar 27 23:39:32 1995 +0000 +++ b/lisp/simple.el Tue Mar 28 03:49:39 1995 +0000 @@ -2809,6 +2809,67 @@ (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