diff options
| author | Stefan Kangas | 2021-12-26 06:47:15 +0100 |
|---|---|---|
| committer | Stefan Kangas | 2021-12-26 17:05:39 +0100 |
| commit | 40dcf9c2abd62425e599f30548dc53fa58fe2202 (patch) | |
| tree | 66cf9b740b06d5c9317d35b2bbc34e23692f77be | |
| parent | 1e7786437d3d471bffe48d91a067556f9223e9cf (diff) | |
| download | emacs-40dcf9c2abd62425e599f30548dc53fa58fe2202.tar.gz emacs-40dcf9c2abd62425e599f30548dc53fa58fe2202.zip | |
read-multiple-choice: Display "SPC" instead of " "
* lisp/emacs-lisp/rmc.el (rmc--add-key-description): Improve display
of the keys TAB, RET, SPC, DEL, and ESC. This fixes a bug where " "
was highlighted in the description in a confusing way.
* test/lisp/emacs-lisp/rmc-tests.el
(test-rmc--add-key-description)
(test-rmc--add-key-description/with-attributes): Update tests for the
above change.
| -rw-r--r-- | lisp/emacs-lisp/rmc.el | 24 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/rmc-tests.el | 9 |
2 files changed, 20 insertions, 13 deletions
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 90fd8b370e8..522d395eba7 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el | |||
| @@ -26,21 +26,23 @@ | |||
| 26 | (require 'seq) | 26 | (require 'seq) |
| 27 | 27 | ||
| 28 | (defun rmc--add-key-description (elem) | 28 | (defun rmc--add-key-description (elem) |
| 29 | (let* ((name (cadr elem)) | 29 | (let* ((char (car elem)) |
| 30 | (pos (seq-position name (car elem))) | 30 | (name (cadr elem)) |
| 31 | (pos (seq-position name char)) | ||
| 32 | (desc (key-description (char-to-string char))) | ||
| 31 | (graphical-terminal | 33 | (graphical-terminal |
| 32 | (display-supports-face-attributes-p | 34 | (display-supports-face-attributes-p |
| 33 | '(:underline t) (window-frame))) | 35 | '(:underline t) (window-frame))) |
| 34 | (altered-name | 36 | (altered-name |
| 35 | (cond | 37 | (cond |
| 36 | ;; Not in the name string. | 38 | ;; Not in the name string, or a special character. |
| 37 | ((not pos) | 39 | ((or (not pos) |
| 38 | (let ((ch (char-to-string (car elem)))) | 40 | (member desc '("ESC" "TAB" "RET" "DEL" "SPC"))) |
| 39 | (format "[%s] %s" | 41 | (format "[%s] %s" |
| 40 | (if graphical-terminal | 42 | (if graphical-terminal |
| 41 | (propertize ch 'face 'read-multiple-choice-face) | 43 | (propertize desc 'face 'read-multiple-choice-face) |
| 42 | ch) | 44 | desc) |
| 43 | name))) | 45 | name)) |
| 44 | ;; The prompt character is in the name, so highlight | 46 | ;; The prompt character is in the name, so highlight |
| 45 | ;; it on graphical terminals. | 47 | ;; it on graphical terminals. |
| 46 | (graphical-terminal | 48 | (graphical-terminal |
| @@ -57,7 +59,7 @@ | |||
| 57 | (upcase (substring name pos (1+ pos))) | 59 | (upcase (substring name pos (1+ pos))) |
| 58 | "]" | 60 | "]" |
| 59 | (substring name (1+ pos))))))) | 61 | (substring name (1+ pos))))))) |
| 60 | (cons (car elem) altered-name))) | 62 | (cons char altered-name))) |
| 61 | 63 | ||
| 62 | (defun rmc--show-help (prompt help-string show-help choices altered-names) | 64 | (defun rmc--show-help (prompt help-string show-help choices altered-names) |
| 63 | (let* ((buf-name (if (stringp show-help) | 65 | (let* ((buf-name (if (stringp show-help) |
diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index a97254c46dc..5a79c505ae2 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el | |||
| @@ -34,7 +34,9 @@ | |||
| 34 | (should (equal (rmc--add-key-description '(?y "yes")) | 34 | (should (equal (rmc--add-key-description '(?y "yes")) |
| 35 | '(?y . "yes"))) | 35 | '(?y . "yes"))) |
| 36 | (should (equal (rmc--add-key-description '(?n "foo")) | 36 | (should (equal (rmc--add-key-description '(?n "foo")) |
| 37 | '(?n . "[n] foo"))))) | 37 | '(?n . "[n] foo"))) |
| 38 | (should (equal (rmc--add-key-description '(?\s "foo bar")) | ||
| 39 | `(?\s . "[SPC] foo bar"))))) | ||
| 38 | 40 | ||
| 39 | (ert-deftest test-rmc--add-key-description/with-attributes () | 41 | (ert-deftest test-rmc--add-key-description/with-attributes () |
| 40 | (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t))) | 42 | (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t))) |
| @@ -43,7 +45,10 @@ | |||
| 43 | `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es")))) | 45 | `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es")))) |
| 44 | (should (equal-including-properties | 46 | (should (equal-including-properties |
| 45 | (rmc--add-key-description '(?n "foo")) | 47 | (rmc--add-key-description '(?n "foo")) |
| 46 | `(?n . ,(concat "[" (propertize "n" 'face 'read-multiple-choice-face) "] foo")))))) | 48 | `(?n . ,(concat "[" (propertize "n" 'face 'read-multiple-choice-face) "] foo")))) |
| 49 | (should (equal-including-properties | ||
| 50 | (rmc--add-key-description '(?\s "foo bar")) | ||
| 51 | `(?\s . ,(concat "[" (propertize "SPC" 'face 'read-multiple-choice-face) "] foo bar")))))) | ||
| 47 | 52 | ||
| 48 | (ert-deftest test-rmc--add-key-description/non-graphical-display () | 53 | (ert-deftest test-rmc--add-key-description/non-graphical-display () |
| 49 | (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil))) | 54 | (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil))) |