[nongnu] elpa/devil cfa68ae95f 2/3: Apply local-function-key-map to translated key

[ELPA Syncer]

branch: elpa/devil
commit cfa68ae95f40fcd9a9f30f109602342d89120d84
Author: Susam Pal <susam@susam.net>
Commit: Susam Pal <susam@susam.net>

    Apply local-function-key-map to translated key
    
    When no binding exists for the translated key sequence, convert the
    key sequence to a fallback key sequence for terminal Emacs according
    to `local-function-key-map` and execute any command bound to the
    fallback key sequence.
    
    For example, when the Devil key sequence `, x <tab>` is converted to
    `C-x <tab>`, since no command is bound to this key sequence, it is
    further translated to `C-x TAB` and the command `indent-rigidly` bound
    to it is executed.
---
 CHANGES.org    |  7 ++++++
 Makefile       |  4 ++--
 devil-tests.el | 27 +++++++++++++++++++++
 devil.el       | 75 ++++++++++++++++++++++++++++++++++++++++++++++++----------
 4 files changed, 98 insertions(+), 15 deletions(-)

diff --git a/CHANGES.org b/CHANGES.org
index d47694c9be..9b403ce25f 100644
--- a/CHANGES.org
+++ b/CHANGES.org
@@ -19,6 +19,13 @@
 *** Changed
 
 - Customising =devil-key= also updates the mode's keymap.
+- When no binding exists for the translated key sequence, convert the
+  key sequence to a fallback key sequence for terminal Emacs according
+  to =local-function-key-map= and execute any command bound to the
+  fallback key sequence.  For example, when the Devil key sequence =,
+  x <tab>= is converted to =C-x <tab>=, since no command is bound to
+  this key sequence, it is further translated to =C-x TAB= and the
+  command =indent-rigidly= bound to it is executed.
 
 *** Fixed
 
diff --git a/Makefile b/Makefile
index c1487521c6..3c24c490d9 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-checks: test test-sentence-ends
+checks: tests test-sentence-ends
 
 test-sentence-ends:
        errors=$$(grep -n '[^0-9]\. [^ lswx."(]' MANUAL.org); echo "$$errors"; 
[ -z "$$errors" ]
@@ -6,5 +6,5 @@ test-sentence-ends:
        errors=$$(grep -n '\. [^ ]' *.el); echo "$$errors"; [ -z "$$errors" ]
        errors=$$(grep -n '[?!] [^ ]' *.org *.el); echo "$$errors"; [ -z 
"$$errors" ]
 
-test:
+tests:
        emacs --batch -l devil.el -l devil-tests.el -f 
ert-run-tests-batch-and-exit
diff --git a/devil-tests.el b/devil-tests.el
index f07a94fc8d..59f9238e29 100644
--- a/devil-tests.el
+++ b/devil-tests.el
@@ -43,6 +43,17 @@
   (should (string= (devil--shifted-key "C-A ") "C-S-a "))
   (should (string= (devil--shifted-key "C-M-A ") "C-M-S-a ")))
 
+(ert-deftest devil-incomplete-key-p ()
+  "Test if `devil--invalid-key-p' works as expected."
+  (should (devil--incomplete-key-p "C-"))
+  (should (devil--incomplete-key-p "C-x C-"))
+  (should (devil--incomplete-key-p "C-M-S-"))
+  (should (not (devil--incomplete-key-p "")))
+  (should (not (devil--incomplete-key-p "C-x-C-f")))
+  (should (not (devil--incomplete-key-p "C-x CC-f")))
+  (should (not (devil--incomplete-key-p "C-x C-f")))
+  (should (not (devil--incomplete-key-p "C-M-x"))))
+
 (ert-deftest devil-invalid-key-p ()
   "Test if `devil--invalid-key-p' works as expected."
   (should (devil--invalid-key-p ""))
@@ -92,5 +103,21 @@
   (should (string= (devil-translate (vconcat ",cmzm")) "C-c M-m"))
   (should (string= (devil-translate (vconcat ",mzm")) "C-M-m")))
 
+(ert-deftest devil-fallback-key ()
+  "Test if `devil-fallback-key' works as expected."
+  (let ((local-function-key-map (make-sparse-keymap)))
+    ;; Define bindings for fallback.
+    (define-key local-function-key-map (kbd "<tab>") (kbd "TAB"))
+    (define-key local-function-key-map (kbd "M-<return>") (kbd "M-RET"))
+    ;; Test translation
+    (should (string= (devil-fallback-key "") nil))
+    (should (string= (devil-fallback-key "a") nil))
+    (should (string= (devil-fallback-key "<return>") nil))
+    (should (string= (devil-fallback-key "C-<tab>") nil))
+    (should (string= (devil-fallback-key "C-<return>") nil))
+    (should (string= (devil-fallback-key "<tab>") "TAB"))
+    (should (string= (devil-fallback-key "M-<return>") "M-RET"))
+    (should (string= (devil-fallback-key "C-<tab> M-<return>") "C-<tab> 
M-RET"))))
+
 (provide 'devil-tests)
 ;;; devil-tests.el ends here
diff --git a/devil.el b/devil.el
index 795530db95..aacdaba63d 100644
--- a/devil.el
+++ b/devil.el
@@ -116,6 +116,7 @@ activated using the given KEY-SEQUENCE."
 (defvar devil-special-keys
   (list (cons "%k %k" (lambda () (interactive) (devil-run-key "%k")))
         (cons "%k SPC" (lambda () (interactive) (devil-run-key "%k SPC")))
+        (cons "%k RET" (lambda () (interactive) (devil-run-key "%k RET")))
         (cons "%k <return>" (lambda () (interactive) (devil-run-key "%k 
RET"))))
   "Special Devil keys that are executed as soon as they are typed.
 
@@ -225,8 +226,9 @@ buffer."
 (defun devil ()
   "Wake up Devil to read and translate Devil key sequences."
   (interactive)
-  (devil--log "Devil waking up")
-  (devil--read-key (this-command-keys)))
+  (devil--log "Devil awake")
+  (devil--read-key (this-command-keys))
+  (devil--log "Devil asleep"))
 
 (defun devil--read-key (key)
   "Read Devil key sequences.
@@ -280,10 +282,12 @@ returned.
 Otherwise, it is translated to an Emacs key sequence using
 `devil-translations'.  If the resulting Emacs key sequence is
 found to be a complete key sequence, the command it is bound to
-is executed interactively and t is returned.  If it is found to be
-an undefined key sequence, then t is returned.  If the resulting
-Emacs key sequence is found to be an incomplete key sequence,
-then nil is returned."
+is executed interactively and t is returned.  If it is found to
+be an undefined key sequence, then t is returned.  If the
+resulting Emacs key sequence is found to be an incomplete key
+sequence, then nil is returned.  The return value t indicates to
+the caller that no more Devil key sequences should be read from
+the user."
   (devil--log "Trying to execute key: %s" (key-description key))
   (or (devil--run-special-command key)
       (devil--run-regular-command key)))
@@ -312,9 +316,25 @@ corresponding Emacs command is executed, and t is 
returned.  If it
 turns out to be an undefined key sequence, t is returned.  The
 return value t indicates to the caller that no more Devil key
 sequences should be read from the user."
-  (let* ((described-key (key-description key))
-         (translated-key (devil-translate key))
-         (parsed-key (condition-case nil (kbd translated-key) (error nil)))
+  (let* ((description (key-description key))
+         (translation (devil-translate key))
+         (fallback (devil-fallback-key translation))
+         (result (devil--run-translation key description translation (not 
fallback))))
+    (if result
+        result
+      (when fallback
+        (devil--run-translation key description fallback t)))))
+
+(defun devil--run-translation (key described-key translated-key default)
+  "Try to run the given TRANSLATED-KEY.
+
+KEY is a vector that represents the original sequence of
+keystrokes from which DESCRIBED-KEY and TRANSLATED-KEY were
+derived.  If TRANSLATED-KEY is an incomplete key sequence, nil is
+returned.  If it is a complete key sequence, the Emacs command
+bound to it is executed, and t is returned.  If it is an
+undefined key sequence, DEFAULT is returned."
+  (let* ((parsed-key (ignore-errors (kbd translated-key)))
          (binding (when parsed-key (key-binding parsed-key))))
     (cond ((string-match "[ACHMSs]-$" translated-key)
            (devil--log "Ignoring incomplete key: %s => %s"
@@ -336,8 +356,9 @@ sequences should be read from the user."
            t)
           (t
            (devil--log "Undefined key: %s => %s" described-key translated-key)
-           (message "Devil: %s is undefined" translated-key)
-           t))))
+           (when default
+             (message "Devil: %s is undefined" translated-key))
+           default))))
 
 (defun devil-translate (key)
   "Translate a given Devil KEY to Emacs key sequence.
@@ -347,26 +368,50 @@ read so far."
   (setq key (key-description key))
   (let ((result "")
         (index 0))
+    ;; Scan Devil key from left to right.
     (while (< index (length key))
       (catch 'break
-        ;; Try translating the current position in Devil key to Emacs key.
+        ;; Try each translation at the current scan position.
         (dolist (entry devil-translations key)
           (let* ((from-key (devil-format (car entry)))
                  (to-key (devil-format (cdr entry)))
                  (in-key (substring key index))
                  (try-key))
             (when (string-prefix-p from-key in-key)
+              ;; Apply matching translation at the current scan position.
               (setq try-key (devil--clean-key (concat result to-key)))
               (unless (devil--invalid-key-p try-key)
+                ;; Translation succeeded.  Do not apply any more
+                ;; translation at the current scan position.  Instead
+                ;; move ahead to the next scan position.
                 (setq result try-key)
                 (setq index (+ index (length from-key)))
                 (throw 'break t)))))
-        ;; If no translation succeeded, advance current position.
+        ;; If no translation succeeded, increment scan position and
+        ;; try applying translations at the new scan position.
         (let ((char (substring key index (1+ index))))
           (setq result (devil--clean-key (concat result char))))
         (setq index (1+ index))))
     (devil--normalize-ctrl-uppercase-chord result)))
 
+(defun devil-fallback-key (translated-key)
+  "Translate TRANSLATED-KEY to an Emacs key sequence for terminal Emacs.
+
+The argument TRANSLATED-KEY is a string that represents an Emacs
+key sequence returned by `devil-translate'.  Each keystroke in
+the key sequence is looked up in `local-function-key-map'.  If a
+match is found, it is replaced with its corresponding binding."
+  (unless (devil--incomplete-key-p translated-key)
+    (let ((result ""))
+      (dolist (chunk (split-string translated-key " " t))
+        (let* ((separator (if (string= result "") "" " "))
+               (binding (lookup-key local-function-key-map (kbd chunk))))
+          (when (and binding (not (keymapp binding)))
+            (setq chunk (key-description binding)))
+          (setq result (concat result separator chunk))))
+      (when (not (member result (list "" translated-key)))
+        result))))
+
 (defun devil--update-command-loop-info (key binding)
   "Update variables that maintain command loop information.
 
@@ -438,6 +483,10 @@ this-command: %s; last-command: %s; 
last-repeatable-command: %s"
          (suffix (substring translated-key hyphen-index)))
     (concat prefix "S-" (downcase suffix))))
 
+(defun devil--incomplete-key-p (translated-key)
+  "Return t iff TRANSLATED-KEY is an incomplete Emacs key sequence."
+  (string-match "[ACHMSs]-$" translated-key))
+
 (defun devil--invalid-key-p (translated-key)
   "Return t iff TRANSLATED-KEY is an invalid Emacs key sequence."
   (catch 'break