branch: elpa/devil
commit 4b1eba8a1ca2b6f79a5f2db0f675f96ec870f73a
Author: Susam Pal <su...@susam.net>
Commit: Susam Pal <su...@susam.net>
Add stricter validation of translated key sequence
Prior to this change, there was a translation issue that caused
invalid Emacs key sequences on mapping `-`. For example, mapping `-`
to `C-x` and typing `- C-f` produced `C-x CC-xf`. This has been
fixed so that `- C-f` is now translated to `C-x C-f`.
---
CHANGES.md | 5 +++++
devil.el | 32 ++++++++++++++++++++------------
2 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/CHANGES.md b/CHANGES.md
index 5d9a355d44..d59500f14f 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -21,6 +21,11 @@ Changelog
### Fixed
- Remove a stray `message` call.
+- Make the function `dev--tests` non-interactive.
+- Translation issue that caused invalid Emacs key sequences on mapping
+ `-`. For example, mapping `-` to `C-x` and typing `- C-f` produced
+ `C-x CC-xf`. This has been fixed so that `- C-f` is now translated
+ to `C-x C-f`.
0.1.0 (2023-05-07)
diff --git a/devil.el b/devil.el
index 1f3812327b..c26b77b5ee 100644
--- a/devil.el
+++ b/devil.el
@@ -254,7 +254,7 @@ sequences should be read from the user."
(translated-key (devil-translate key))
(parsed-key (condition-case nil (kbd translated-key) (error nil)))
(binding (when parsed-key (key-binding parsed-key))))
- (cond ((string-match "[ACHMsS]-$" translated-key)
+ (cond ((string-match "[ACHMSs]-$" translated-key)
(devil--log "Ignoring incomplete key: %s => %s"
described-key translated-key)
nil)
@@ -293,7 +293,7 @@ read so far."
(try-key))
(when (string-prefix-p from-key in-key)
(setq try-key (devil--clean-key (concat result to-key)))
- (when (devil--valid-key-p try-key)
+ (unless (devil--invalid-key-p try-key)
(setq result try-key)
(setq index (+ index (length from-key)))
(throw 'break t)))))
@@ -359,13 +359,16 @@ the original Emacs key sequence."
(defun devil--clean-key (translated-key)
"Clean up TRANSLATED-KEY to properly formatted Emacs key sequence."
- (replace-regexp-in-string "\\([ACHMsS]\\)- " "\\1-" translated-key))
+ (replace-regexp-in-string "\\([ACHMSs]\\)- " "\\1-" translated-key))
-(defun devil--valid-key-p (translated-key)
- "Return nil iff TRANSLATED-KEY is an invalid Emacs key sequence."
- (not (string-match-p (concat "A-[^ ]*A-\\|" "C-[^ ]*C-\\|" "H-[^ ]*H-\\|"
- "M-[^ ]*M-\\|" "s-[^ ]*s-\\|" "S-[^ ]*S-")
- translated-key)))
+(defun devil--invalid-key-p (translated-key)
+ "Return t iff TRANSLATED-KEY is an invalid Emacs key sequence."
+ (catch 'break
+ (dolist (chunk (split-string translated-key " "))
+ (when (or (string= chunk "")
+ (not (string-match-p "^\\(?:[ACHMSs]-\\)*[^ ]?$" chunk))
+ (string-match-p "\\([ACHMSs]-\\)[^ ]*\\1" chunk))
+ (throw 'break t)))))
(defun devil-format (string)
"Replace %k in STRING with `devil-key'."
@@ -383,16 +386,21 @@ the original Emacs key sequence."
(defun devil--tests ()
"Test Devil functions assuming Devil has not been customized."
+ (devil--assert (devil--invalid-key-p ""))
+ (devil--assert (devil--invalid-key-p "C-x-C-f"))
+ (devil--assert (devil--invalid-key-p "C-x CC-f"))
+ (devil--assert (not (devil--invalid-key-p "C-x C-f")))
+ (devil--assert (not (devil--invalid-key-p "C-M-x")))
(devil--assert (string= (devil-translate (vconcat ",")) "C-"))
(devil--assert (string= (devil-translate (vconcat ",x")) "C-x"))
(devil--assert (string= (devil-translate (vconcat ",x,")) "C-x C-"))
(devil--assert (string= (devil-translate (vconcat ",x,f")) "C-x C-f"))
- (devil--assert (string= (devil-translate (vconcat ",,")) "C-,"))
- (devil--assert (string= (devil-translate (vconcat ",,,,")) "C-, C-,"))
+ (devil--assert (string= (devil-translate (vconcat ",,")) ","))
+ (devil--assert (string= (devil-translate (vconcat ",,,,")) ", ,"))
(devil--assert (string= (devil-translate (vconcat ",mx")) "C-M-x"))
- (devil--assert (string= (devil-translate (vconcat ",,mx")) "M-x"))
+ (devil--assert (string= (devil-translate (vconcat ",mmx")) "M-x"))
(devil--assert (string= (devil-translate (vconcat ",mmm")) "M-m"))
- (devil--log "Tests completed"))
+ (message "Done"))
(provide 'devil)
