From 82072f33f9384ddfd12a21004fff8820f063d700 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 28 Mar 1995 03:49:39 +0000 Subject: [PATCH] (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. --- lisp/simple.el | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/lisp/simple.el b/lisp/simple.el index 922912bd3e3..90ee2642c9d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2809,6 +2809,67 @@ select the completion near point.\n\n")) (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 -- 2.39.5