emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/devil 4729fb499f 1/2: Apply local-function-key-map to spec


From: ELPA Syncer
Subject: [nongnu] elpa/devil 4729fb499f 1/2: Apply local-function-key-map to special key
Date: Sun, 11 Jun 2023 22:00:57 -0400 (EDT)

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

    Apply local-function-key-map to special key
---
 devil-tests.el | 28 ++++++++++++++--------------
 devil.el       | 54 +++++++++++++++++++++++++++---------------------------
 2 files changed, 41 insertions(+), 41 deletions(-)

diff --git a/devil-tests.el b/devil-tests.el
index c2d31c8862..90fb0004f1 100644
--- a/devil-tests.el
+++ b/devil-tests.el
@@ -61,7 +61,7 @@
 
 ;;; Command Lookup ===================================================
 
-(ert-deftest devil-incomplete-key-p ()
+(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-"))
@@ -116,23 +116,23 @@
   (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."
+(ert-deftest devil--terminal-key ()
+  "Test if `devil--terminal-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"))))
-
-(ert-deftest devil-shifted-key ()
+    (should (string= (devil--terminal-key "") ""))
+    (should (string= (devil--terminal-key "a") "a"))
+    (should (string= (devil--terminal-key "<return>") "<return>"))
+    (should (string= (devil--terminal-key "C-<tab>") "C-<tab>"))
+    (should (string= (devil--terminal-key "C-<return>") "C-<return>"))
+    (should (string= (devil--terminal-key "<tab>") "TAB"))
+    (should (string= (devil--terminal-key "M-<return>") "M-RET"))
+    (should (string= (devil--terminal-key "C-<tab> M-<return>") "C-<tab> 
M-RET"))))
+
+(ert-deftest devil--shifted-key ()
   "Test if `devil--shifted-key' works as expected."
   (should (string= (devil--shifted-key "A") "S-a"))
   (should (string= (devil--shifted-key "C-A") "C-S-a"))
@@ -141,7 +141,7 @@
   (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-invalid-key-p ()
+(ert-deftest devil--invalid-key-p ()
   "Test if `devil--invalid-key-p' works as expected."
   (should (devil--invalid-key-p ""))
   (should (devil--invalid-key-p "C-x-C-f"))
diff --git a/devil.el b/devil.el
index 8b5713bc8a..e49a5f61b5 100644
--- a/devil.el
+++ b/devil.el
@@ -48,7 +48,7 @@
   :prefix "devil-"
   :group 'editing)
 
-(defconst devil-version "0.5.0-beta3"
+(defconst devil-version "0.5.0-beta4"
   "Devil version string.")
 
 (defvar devil-mode-map (make-sparse-keymap)
@@ -302,6 +302,9 @@ in the format control string."
 
 ;;; Command Lookup ===================================================
 
+(defconst devil--fallbacks (list #'devil--terminal-key)
+  "A list of functions that further translate a translated key.")
+
 (defun devil--read-key (prompt key)
   "Read Devil key sequence.
 
@@ -338,7 +341,7 @@ is returned.  Otherwise nil is returned."
       (when (string= (key-description key) (devil-format (car entry)))
         (devil--log "Found special command: %s => %s"
                     (key-description key) (cdr entry))
-        (throw 'break (devil--make-result key nil (cdr entry)))))))
+        (throw 'break (devil--binding-result key nil (cdr entry)))))))
 
 (defun devil--find-regular-command (key)
   "Translate KEY and find command bound to it.
@@ -347,18 +350,16 @@ After translating the given key sequence vector KEY to an 
Emacs
 key sequence, if the resulting key sequence turns out to be an
 incomplete key, then nil is returned.  If it turns out to be a
 complete key sequence, a non-nil result is returned."
-  (let* ((translated-key (devil--translate key))
-         (binding (devil--find-command translated-key)))
-    (when (eq binding 'devil--undefined)
-      (let ((fallback-key (devil--fallback-key translated-key)))
-        (when fallback-key
-          (setq translated-key fallback-key)
-          (setq binding (devil--find-command fallback-key)))))
-    (when binding
-      (devil--make-result key translated-key binding))))
-
-(defun devil--find-command (translated-key)
-  "Find command bound to TRANSLATED-KEY."
+  (devil--find-command key (devil--translate key) devil--fallbacks))
+
+(defun devil--find-command (key translated-key fallbacks)
+  "Find command bound to TRANSLATED-KEY translated from KEY.
+
+FALLBACKS is a list of functions.  When FALLBACKS is non-nil and
+no binding is found for the given TRANSLATED-KEY, the given
+TRANSLATED-KEY is translated further by invoking the `car' of
+this list.  Then this function is called recursively with the
+`cdr' of this list."
   (let* ((parsed-key (ignore-errors (kbd translated-key)))
          (binding (when parsed-key (key-binding parsed-key))))
     (cond ((devil--incomplete-key-p translated-key)
@@ -369,16 +370,20 @@ complete key sequence, a non-nil result is returned."
            nil)
           ((commandp binding)
            (devil--log "Found command: %s => %s" translated-key binding)
-           binding)
+           (devil--binding-result key translated-key binding))
           (t
            (devil--log "Undefined key: %s => %s" translated-key binding)
-           'devil--undefined))))
+           (let ((fallback-key (when fallbacks (funcall (car fallbacks)
+                                                        translated-key))))
+             (if (and fallback-key (not (string= translated-key fallback-key)))
+                 (devil--find-command key fallback-key (cdr fallbacks))
+               (devil--binding-result key translated-key nil)))))))
 
 (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--make-result (key translated-key binding)
+(defun devil--binding-result (key translated-key binding)
   "Create alist for the given KEY, TRANSLATED-KEY, and BINDING."
   (list (cons 'key key)
         (cons 'translated-key translated-key)
@@ -392,12 +397,7 @@ complete key sequence, a non-nil result is returned."
 
 KEY is a key sequence vector that represents a Devil key
 sequence.  The returned value is an Emacs key sequence string in
-the format returned by commands such as `C-h k' (`describe-key').
-
-If FALLBACK is non-nil, the translated key is further translated
-using `local-function-key-map'.  In this case, if this further
-translation does not yield a new translation, then nil is
-returned."
+the format returned by commands such as `C-h k' (`describe-key')."
   (setq key (key-description key))
   (let ((result "")
         (index 0))
@@ -427,7 +427,7 @@ returned."
         (setq index (1+ index))))
     (devil--normalize-ctrl-uppercase-chord result)))
 
-(defun devil--fallback-key (translated-key)
+(defun devil--terminal-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
@@ -442,8 +442,7 @@ match is found, it is replaced with its corresponding 
binding."
           (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))))
+      result)))
 
 (defun devil--clean-key (translated-key)
   "Clean up TRANSLATED-KEY to properly formatted Emacs key sequence."
@@ -496,7 +495,8 @@ k' (`describe-key').  Format control sequences supported by
     (dolist (chunk (split-string key " " t))
       (let ((separator (if (string= accumulator "") "" " ")))
         (setq accumulator (concat accumulator separator chunk)))
-      (let ((binding (devil--find-command accumulator)))
+      (let* ((result (devil--find-command key accumulator devil--fallbacks))
+             (binding (devil--aget 'binding result)))
         (cond ((not binding))
               ((eq binding 'devil--undefined)
                (message "Devil: %s is undefined" accumulator)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]