[nongnu] elpa/devil c45ab996ca: Translate chords with C-uppercase to C-S-lowercase

[ELPA Syncer]

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

    Translate chords with C-uppercase to C-S-lowercase
---
 CHANGES.org    |  7 +++++++
 MANUAL.org     | 24 ++++++++++++++++--------
 Makefile       |  2 ++
 devil-tests.el | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++--
 devil.el       | 37 ++++++++++++++++++++++++++++++-------
 5 files changed, 108 insertions(+), 17 deletions(-)

diff --git a/CHANGES.org b/CHANGES.org
index 22b0517703..b2bcadfec1 100644
--- a/CHANGES.org
+++ b/CHANGES.org
@@ -9,6 +9,13 @@
 
 - Add customisable variable =devil-all-keys-repeatable=.
 
+*** Changed
+
+- When a Devil key sequence translates to an Emacs key sequence with
+  both the control key and an uppercase letter, the uppercase letter
+  is further translated to its shifted form, e.g., =C-M-V= is
+  translated to =C-M-S-v=.
+
 *** Fixed
 
 - Fix key translation when the Devil key is a key vector, e.g., =(kbd
diff --git a/MANUAL.org b/MANUAL.org
index bb6937830c..9db5cbaff5 100644
--- a/MANUAL.org
+++ b/MANUAL.org
@@ -322,14 +322,22 @@ user to an Emacs key sequence:
    Devil normalises the result to =C-x C-f= by removing the stray
    spaces after the modifier keys.
 
-3. However, if the simple string based replacement leads to an invalid
-   Emacs key sequence, it skips the replacement that causes the
-   resulting Emacs key sequence to become invalid.  For example =, m
-   ,= results in =C-M-C-= after the simple string replacement because
-   the default translation rules replace =,= with =C-= and =m= with
-   =M-=.  However, =C-M-C-= is an invalid key sequence, so the
-   replacement of the second =,= to =C-= is skipped.  Therefore, the
-   input =, m ,= is translated to =C-M-,= instead.
+3. If the simple string based replacement discussed in the previous
+   point leads to an invalid Emacs key sequence, it skips the
+   replacement that causes the resulting Emacs key sequence to become
+   invalid.  For example =, m ,= results in =C-M-C-= after the simple
+   string replacement because the default translation rules replace
+   =,= with =C-= and =m= with =M-=.  However, =C-M-C-= is an invalid
+   key sequence, so the replacement of the second =,= to =C-= is
+   skipped.  Therefore, the input =, m ,= is translated to =C-M-,=
+   instead.
+
+4. Finally, Devil looks for key chords in the key sequence that
+   contain both the =C-= modifier and an uppercase letter.  If such a
+   key chord occurs, then it replaces the uppercase letter with its
+   shifted form, e.g., =, m V= first translates to =C-M-V= according
+   to the previous points and then the result is translated to
+   =C-M-S-v= according to this point.
 
 * Translation Examples
 :PROPERTIES:
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000000..ae1fa4f149
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,2 @@
+test:
+       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 22e7071201..ac95e6c253 100644
--- a/devil-tests.el
+++ b/devil-tests.el
@@ -10,8 +10,41 @@
 (require 'ert)
 (require 'devil)
 
+(ert-deftest devil-string-replace ()
+  "Test if `devil-string-replace' works as expected."
+  (should (string= (devil-string-replace "" "" "") ""))
+  (should (string= (devil-string-replace "" "foo" "") ""))
+  (should (string= (devil-string-replace "foo" "foo" "foo") "foo"))
+  (should (string= (devil-string-replace "foo" "bar" "") ""))
+  (should (string= (devil-string-replace "foo" "bar" "foo") "bar"))
+  (should (string= (devil-string-replace "foo" "bar" "Foo") "Foo"))
+  (should (string= (devil-string-replace "foo" "bar" "FOO") "FOO"))
+  (should (string= (devil-string-replace "f.." "bar" "foo f..") "foo bar"))
+  (should (string= (devil-string-replace "f.." "<\\&>" "foo f..") "foo 
<\\&>")))
+
+(ert-deftest devil-regexp-replace ()
+  "Test if `devil-string-replace' works as expected."
+  (should (string= (devil-regexp-replace "" "" "") ""))
+  (should (string= (devil-regexp-replace "" "foo" "") ""))
+  (should (string= (devil-regexp-replace "foo" "foo" "foo") "foo"))
+  (should (string= (devil-regexp-replace "foo" "bar" "") ""))
+  (should (string= (devil-regexp-replace "foo" "bar" "foo") "bar"))
+  (should (string= (devil-regexp-replace "foo" "bar" "Foo") "Foo"))
+  (should (string= (devil-regexp-replace "foo" "bar" "FOO") "FOO"))
+  (should (string= (devil-regexp-replace "f.." "bar" "foo f..") "bar bar"))
+  (should (string= (devil-regexp-replace "f.." "<\\&>" "foo f..") "<foo> 
<f..>")))
+
+(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"))
+  (should (string= (devil--shifted-key "C-M-A") "C-M-S-a"))
+  (should (string= (devil--shifted-key "A ") "S-a "))
+  (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 ()
-  "Test if `devil--invalid-key-p' words as expected."
+  "Test if `devil--invalid-key-p' works as expected."
   (should (devil--invalid-key-p ""))
   (should (devil--invalid-key-p "C-x-C-f"))
   (should (devil--invalid-key-p "C-x CC-f"))
@@ -20,15 +53,33 @@
 
 (ert-deftest devil-translate ()
   "Test if `devil-translate' works as expected."
+  ;; Trivial translations.
+  (should (string= (devil-translate (vconcat "a")) "a"))
+  (should (string= (devil-translate (vconcat "A")) "A"))
+  ;; Translations involving the C- modifier.
   (should (string= (devil-translate (vconcat ",")) "C-"))
   (should (string= (devil-translate (vconcat ",x")) "C-x"))
   (should (string= (devil-translate (vconcat ",x,")) "C-x C-"))
   (should (string= (devil-translate (vconcat ",x,f")) "C-x C-f"))
+  ;; Escape hatch to type commas.
   (should (string= (devil-translate (vconcat ",,")) ","))
   (should (string= (devil-translate (vconcat ",,,,")) ", ,"))
+  ;; Translations involving M- modifier.
   (should (string= (devil-translate (vconcat ",mx")) "C-M-x"))
   (should (string= (devil-translate (vconcat ",mmx")) "M-x"))
-  (should (string= (devil-translate (vconcat ",mmm")) "M-m")))
+  (should (string= (devil-translate (vconcat ",mmm")) "M-m"))
+  ;; Translations involing C- and uppercase letter.
+  (should (string= (devil-translate (vconcat ",a")) "C-a"))
+  (should (string= (devil-translate (vconcat ",A")) "C-S-a"))
+  (should (string= (devil-translate (vconcat ",mA")) "C-M-S-a"))
+  (should (string= (devil-translate (vconcat ",mmA")) "M-A"))
+  (should (string= (devil-translate (vconcat ",A,mA,a")) "C-S-a C-M-S-a C-a"))
+  (should (string= (devil-translate (vconcat ",AmA,mmA,a")) "C-S-a M-A M-A 
C-a"))
+  ;; Translations involving C- and RET.
+  (should (string= (devil-translate (vconcat ",\r")) "C-RET"))
+  (should (string= (devil-translate (vconcat ",m\r")) "C-M-RET"))
+  (should (string= (devil-translate (vconcat ",mm\r")) "M-RET"))
+  (should (string= (devil-translate (vconcat ",\r,R,mm\r")) "C-RET C-S-r 
M-RET")))
 
 (provide 'devil-tests)
 ;;; devil-tests.el ends here
diff --git a/devil.el b/devil.el
index e966b157b0..a76caf1c73 100644
--- a/devil.el
+++ b/devil.el
@@ -4,7 +4,7 @@
 
 ;; Author: Susam Pal <susam@susam.net>
 ;; Maintainer: Susam Pal <susam@susam.net>
-;; Version: 0.4.0.pre
+;; Version: 0.4.0.pre2
 ;; Package-Requires: ((emacs "24.4"))
 ;; Keywords: convenience, abbrev
 ;; URL: https://github.com/susam/devil
@@ -231,8 +231,8 @@ The following format control sequences are supported:
                         (cons "%t" (devil-translate key))
                         (cons "%%" "%"))))
     (dolist (control controls result)
-      (setq result (replace-regexp-in-string (car control)
-                                             (cdr control) result)))))
+      (setq result (devil-string-replace (car control)
+                                         (cdr control) result)))))
 
 (defun devil--run-command (key)
   "Try running the command bound to the key sequence in KEY.
@@ -330,7 +330,7 @@ read so far."
         (let ((char (substring key index (1+ index))))
           (setq result (devil--clean-key (concat result char))))
         (setq index (1+ index))))
-    result))
+    (devil--normalize-ctrl-uppercase-chord result)))
 
 (defun devil--update-command-loop-info (key binding)
   "Update variables that maintain command loop information.
@@ -389,20 +389,43 @@ this-command: %s; last-command: %s; 
last-repeatable-command: %s"
 
 (defun devil--clean-key (translated-key)
   "Clean up TRANSLATED-KEY to properly formatted Emacs key sequence."
-  (replace-regexp-in-string "\\([ACHMSs]\\)- " "\\1-" translated-key))
+  (devil-regexp-replace "\\([ACHMSs]\\)- " "\\1-" translated-key))
+
+(defun devil--normalize-ctrl-uppercase-chord (translated-key)
+  "Normalize chords containing ctrl and uppercase letter in TRANSLATED-KEY."
+  (devil-regexp-replace "C-\\(?:[ACHMs]-\\)*[A-Z]\\(?: \\|$\\)"
+                        'devil--shifted-key translated-key))
+
+(defun devil--shifted-key (translated-key)
+  "Replace the last character in TRANSLATED-KEY with its shifted form."
+  (let* ((hyphen-index (if (string-suffix-p " " translated-key) -2 -1))
+         (prefix (substring translated-key 0 hyphen-index))
+         (suffix (substring translated-key hyphen-index)))
+    (concat prefix "S-" (downcase suffix))))
 
 (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))
+                (not (string-match-p "^\\(?:[ACHMSs]-\\)*[^-]*$" chunk))
                 (string-match-p "\\([ACHMSs]-\\)[^ ]*\\1" chunk))
         (throw 'break t)))))
 
 (defun devil-format (string)
   "Replace %k in STRING with `key-description' of `devil-key'."
-  (replace-regexp-in-string "%k" (key-description devil-key) string))
+  (devil-string-replace "%k" (key-description devil-key) string))
+
+(defun devil-string-replace (from-string to-string in-string)
+  "Replace FROM-STRING with TO-STRING in IN-STRING."
+  (let ((case-fold-search nil))
+    (replace-regexp-in-string (regexp-quote from-string)
+                              to-string in-string t t)))
+
+(defun devil-regexp-replace (regexp replacement in-string)
+  "Replace REGEXP with REPLACEMENT in IN-STRING."
+  (let ((case-fold-search nil))
+    (replace-regexp-in-string regexp replacement in-string t)))
 
 (defun devil--log (format-string &rest args)
   "Write log message with the given FORMAT-STRING and ARGS."