aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMattias EngdegÄrd2022-06-18 11:08:23 +0200
committerMattias EngdegÄrd2022-06-18 11:22:58 +0200
commite321f87aa76c959faed784851b65ab7ada3fd129 (patch)
tree0f3450adff77e3a73df7b5786c39333b58e09e97
parent15238e2ed0eeba82fd43efbbd4b9237394f9fd55 (diff)
downloademacs-e321f87aa76c959faed784851b65ab7ada3fd129.tar.gz
emacs-e321f87aa76c959faed784851b65ab7ada3fd129.zip
Avoid "control-control-KEY" (bug#55738)
Constructs such as ?\C-^@ or ?\C-\C-m literally apply a Control modifier twice which doesn't make sense at all. What is really meant is a C0 base character with the Control modifier bit set. This change is only stylistic in nature. * lisp/edmacro.el (edmacro-format-keys): * lisp/keymap.el (key-parse): * lisp/subr.el (event-modifiers, event-basic-type): * test/lisp/subr-tests.el (subr-test-kbd): Use \0 and \r instead of ^@ and \C-m to represent NUL and RET when combined with other modifiers.
-rw-r--r--lisp/edmacro.el4
-rw-r--r--lisp/keymap.el14
-rw-r--r--lisp/subr.el18
-rw-r--r--test/lisp/subr-tests.el2
4 files changed, 19 insertions, 19 deletions
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index fe1fc086bc6..04adabd06bc 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -532,8 +532,8 @@ doubt, use whitespace."
532 ((integerp ch) 532 ((integerp ch)
533 (concat 533 (concat
534 (cl-loop for pf across "ACHMsS" 534 (cl-loop for pf across "ACHMsS"
535 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ 535 for bit in '( ?\A-\0 ?\C-\0 ?\H-\0
536 ?\M-\^@ ?\s-\^@ ?\S-\^@) 536 ?\M-\0 ?\s-\0 ?\S-\0)
537 when (/= (logand ch bit) 0) 537 when (/= (logand ch bit) 0)
538 concat (format "%c-" pf)) 538 concat (format "%c-" pf))
539 (let ((ch2 (logand ch (1- (ash 1 18))))) 539 (let ((ch2 (logand ch (1- (ash 1 18)))))
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 71454eba5e5..3a22610499c 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -241,13 +241,13 @@ See `kbd' for a descripion of KEYS."
241 (setq bits (+ bits 241 (setq bits (+ bits
242 (cdr 242 (cdr
243 (assq (aref word 0) 243 (assq (aref word 0)
244 '((?A . ?\A-\^@) (?C . ?\C-\^@) 244 '((?A . ?\A-\0) (?C . ?\C-\0)
245 (?H . ?\H-\^@) (?M . ?\M-\^@) 245 (?H . ?\H-\0) (?M . ?\M-\0)
246 (?s . ?\s-\^@) (?S . ?\S-\^@)))))) 246 (?s . ?\s-\0) (?S . ?\S-\0))))))
247 (setq prefix (+ prefix 2)) 247 (setq prefix (+ prefix 2))
248 (setq word (substring word 2))) 248 (setq word (substring word 2)))
249 (when (string-match "^\\^.$" word) 249 (when (string-match "^\\^.$" word)
250 (setq bits (+ bits ?\C-\^@)) 250 (setq bits (+ bits ?\C-\0))
251 (setq prefix (1+ prefix)) 251 (setq prefix (1+ prefix))
252 (setq word (substring word 1))) 252 (setq word (substring word 1)))
253 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") 253 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
@@ -262,19 +262,19 @@ See `kbd' for a descripion of KEYS."
262 (setq word (vector n)))) 262 (setq word (vector n))))
263 (cond ((= bits 0) 263 (cond ((= bits 0)
264 (setq key word)) 264 (setq key word))
265 ((and (= bits ?\M-\^@) (stringp word) 265 ((and (= bits ?\M-\0) (stringp word)
266 (string-match "^-?[0-9]+$" word)) 266 (string-match "^-?[0-9]+$" word))
267 (setq key (mapcar (lambda (x) (+ x bits)) 267 (setq key (mapcar (lambda (x) (+ x bits))
268 (append word nil)))) 268 (append word nil))))
269 ((/= (length word) 1) 269 ((/= (length word) 1)
270 (error "%s must prefix a single character, not %s" 270 (error "%s must prefix a single character, not %s"
271 (substring orig-word 0 prefix) word)) 271 (substring orig-word 0 prefix) word))
272 ((and (/= (logand bits ?\C-\^@) 0) (stringp word) 272 ((and (/= (logand bits ?\C-\0) 0) (stringp word)
273 ;; We used to accept . and ? here, 273 ;; We used to accept . and ? here,
274 ;; but . is simply wrong, 274 ;; but . is simply wrong,
275 ;; and C-? is not used (we use DEL instead). 275 ;; and C-? is not used (we use DEL instead).
276 (string-match "[@-_a-z]" word)) 276 (string-match "[@-_a-z]" word))
277 (setq key (list (+ bits (- ?\C-\^@) 277 (setq key (list (+ bits (- ?\C-\0)
278 (logand (aref word 0) 31))))) 278 (logand (aref word 0) 31)))))
279 (t 279 (t
280 (setq key (list (+ bits (aref word 0))))))))) 280 (setq key (list (+ bits (aref word 0)))))))))
diff --git a/lisp/subr.el b/lisp/subr.el
index c1c9759b03d..d14efccd82e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1542,21 +1542,21 @@ the `click' modifier."
1542 ;; sure the symbol has already been parsed. 1542 ;; sure the symbol has already been parsed.
1543 (cdr (internal-event-symbol-parse-modifiers type)) 1543 (cdr (internal-event-symbol-parse-modifiers type))
1544 (let ((list nil) 1544 (let ((list nil)
1545 (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@ 1545 (char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0
1546 ?\H-\^@ ?\s-\^@ ?\A-\^@))))) 1546 ?\H-\0 ?\s-\0 ?\A-\0)))))
1547 (if (not (zerop (logand type ?\M-\^@))) 1547 (if (not (zerop (logand type ?\M-\0)))
1548 (push 'meta list)) 1548 (push 'meta list))
1549 (if (or (not (zerop (logand type ?\C-\^@))) 1549 (if (or (not (zerop (logand type ?\C-\0)))
1550 (< char 32)) 1550 (< char 32))
1551 (push 'control list)) 1551 (push 'control list))
1552 (if (or (not (zerop (logand type ?\S-\^@))) 1552 (if (or (not (zerop (logand type ?\S-\0)))
1553 (/= char (downcase char))) 1553 (/= char (downcase char)))
1554 (push 'shift list)) 1554 (push 'shift list))
1555 (or (zerop (logand type ?\H-\^@)) 1555 (or (zerop (logand type ?\H-\0))
1556 (push 'hyper list)) 1556 (push 'hyper list))
1557 (or (zerop (logand type ?\s-\^@)) 1557 (or (zerop (logand type ?\s-\0))
1558 (push 'super list)) 1558 (push 'super list))
1559 (or (zerop (logand type ?\A-\^@)) 1559 (or (zerop (logand type ?\A-\0))
1560 (push 'alt list)) 1560 (push 'alt list))
1561 list)))) 1561 list))))
1562 1562
@@ -1570,7 +1570,7 @@ in the current Emacs session, then this function may return nil."
1570 (setq event (car event))) 1570 (setq event (car event)))
1571 (if (symbolp event) 1571 (if (symbolp event)
1572 (car (get event 'event-symbol-elements)) 1572 (car (get event 'event-symbol-elements))
1573 (let* ((base (logand event (1- ?\A-\^@))) 1573 (let* ((base (logand event (1- ?\A-\0)))
1574 (uncontrolled (if (< base 32) (logior base 64) base))) 1574 (uncontrolled (if (< base 32) (logior base 64) base)))
1575 ;; There are some numbers that are invalid characters and 1575 ;; There are some numbers that are invalid characters and
1576 ;; cause `downcase' to get an error. 1576 ;; cause `downcase' to get an error.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index a25eb363b01..45dd2d71603 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -112,7 +112,7 @@
112 (should (equal (kbd "C-x C-f") "\C-x\C-f")) 112 (should (equal (kbd "C-x C-f") "\C-x\C-f"))
113 (should (equal (kbd "C-M-<down>") [C-M-down])) 113 (should (equal (kbd "C-M-<down>") [C-M-down]))
114 (should (equal (kbd "<C-M-down>") [C-M-down])) 114 (should (equal (kbd "<C-M-down>") [C-M-down]))
115 (should (equal (kbd "C-RET") [?\C-\C-m])) 115 (should (equal (kbd "C-RET") [?\C-\r]))
116 (should (equal (kbd "C-SPC") [?\C- ])) 116 (should (equal (kbd "C-SPC") [?\C- ]))
117 (should (equal (kbd "C-TAB") [?\C-\t])) 117 (should (equal (kbd "C-TAB") [?\C-\t]))
118 (should (equal (kbd "C-<down>") [C-down])) 118 (should (equal (kbd "C-<down>") [C-down]))