[elpa] 43/287: Be more conservative with substituting key commands.

[Matthew Fidler]

mlf176f2 pushed a commit to branch externals/ergoemacs-mode
in repository elpa.

commit 9141572b3fdc45747fa03c3ac0dc9ba17250a340
Author: Matthew L. Fidler <address@hidden>
Date:   Wed Jun 4 13:32:44 2014 -0500

    Be more conservative with substituting key commands.
---
 ergoemacs-advices.el      |  129 +++++++++++++++++++++++++++++++++++++++++++++
 ergoemacs-mode.el         |   18 +------
 ergoemacs-theme-engine.el |   25 +++++++--
 ergoemacs-translate.el    |   14 ++++--
 4 files changed, 161 insertions(+), 25 deletions(-)

diff --git a/ergoemacs-advices.el b/ergoemacs-advices.el
index e524476..0e22daf 100644
--- a/ergoemacs-advices.el
+++ b/ergoemacs-advices.el
@@ -40,6 +40,7 @@
 (require 'ergoemacs-shortcuts)
 (require 'ergoemacs-unbind)
 
+
 (defmacro ergoemacs-define-overrides (&rest body)
   "Force the define-keys to work"
   `(let ((ergoemacs-run-mode-hooks t))
@@ -223,6 +224,134 @@ This assumes any key defined while running a hook is a 
user-defined hook."
   (ergoemacs-with-global
    ad-do-it))
 
+;;; Unfortunately, the advice route doesn't seem to work :(
+
+(fset 'ergoemacs-real-substitute-command-keys (symbol-function 
'substitute-command-keys))
+
+(defun ergoemacs-substitute-command (string &optional map)
+  "Substitutes command STRING
+will add MAP to substitution."
+  (save-match-data
+    (let* (ret
+           (test (ergoemacs-with-global
+                  (ergoemacs-real-substitute-command-keys
+                   (or (and map (concat map string)) string))))
+           (test-vect (read-kbd-macro test t))
+           (test-hash (gethash test-vect 
ergoemacs-original-keys-to-shortcut-keys)))
+      (if test-hash
+          (progn
+            (ergoemacs-pretty-key (key-description (nth 0 test-hash))))
+        (let (ergoemacs-modal ergoemacs-repeat-keys ergoemacs-read-input-keys)
+          (ergoemacs-pretty-key
+           (ergoemacs-real-substitute-command-keys
+            (or (and map (concat map string)) string))))))))
+
+(defun ergoemacs-substitute-map--1 (string)
+  (substring
+   (replace-regexp-in-string
+    "`\\(binding\\|Prefix Command\\|-------\\)'" "\\1"
+    (replace-regexp-in-string
+     "---|\n|-" "---|"
+     (replace-regexp-in-string
+      "^|'[ \t]*|$" "|-"
+      (replace-regexp-in-string
+       "' |\n.*(that binding is.*\n|'" "' (shadowed)"
+       (replace-regexp-in-string
+        "^" "|"
+        (replace-regexp-in-string
+         "$" "' |"
+         (replace-regexp-in-string
+          "\\([ \t]\\{2,\\}\\|\t\\)" "\\1 | `"
+          string))))))) 0 -2))
+
+(defun ergoemacs-substitute-map (string &optional function)
+  (save-match-data
+    (let* (ret
+           ergoemacs-use-unicode-brackets
+           (max1 0) (max2 0)
+           (function (or function 'ergoemacs-real-substitute-command-keys))
+           (test (ergoemacs-with-global
+                  (funcall function string)))
+           (shortcut-list '()))
+      (while (string-match (format 
"^%s.*$"ergoemacs-original-keys-to-shortcut-keys-regexp) test)
+        (push (match-string 0 test) shortcut-list)
+        (setq test
+              (replace-match "" nil nil test)))
+      (let (ergoemacs-modal ergoemacs-repeat-keys ergoemacs-read-input-keys)
+        (setq test (funcall function string))
+        (while (string-match "^.*\\<ergoemacs-shortcut.*\n" test)
+          (setq test (replace-match "" test)))
+        (when (string-match ".*\n.*\n" test)
+          (setq ret (ergoemacs-substitute-map--1
+                     (concat (match-string 0 test)
+                             (mapconcat (lambda(x) x) shortcut-list "\n")
+                             (replace-match "" nil nil test))))))
+      (with-temp-buffer
+        (insert ret)
+        (goto-char (point-min))
+        (forward-line 2)
+        (while (re-search-forward "^|\\(.*?\\)[ \t]+|" nil t)
+          (setq test (ergoemacs-pretty-key (match-string 1)))
+          (replace-match (format "| %s |" test))
+          (setq max1 (max max1 (length test))
+                max2 (max max2 (length (buffer-substring (point) 
(point-at-eol))))))
+        (setq test (concat "|"
+                           (make-string (+ max1 2) ?-)
+                           "+"
+                           (make-string (- max2 1) ?-)
+                           "|"))
+        (goto-char (point-min))
+        (insert test "\n")
+        (while (re-search-forward "|-.*\\(\n|-.*\\)*" nil t)
+          (replace-match test))
+        (goto-char (point-min))
+        (while (re-search-forward "^| *\\(.*?[^ ]\\) +| *\\(.*?[^ ]\\) +|$" 
nil t)
+          (replace-match (format "| \\1%s | \\2%s |"
+                                 (make-string (max 0 (- max1 (length 
(match-string 1)))) ? )
+                                 (make-string (max 0 (- max2 (+ 3 (length 
(match-string 2))))) ? ))))
+        (goto-char (point-max))
+        (insert "\n" test "\n\n")
+        (setq ret (buffer-string)))
+      ret)))
+
+
+
+(defun substitute-command-keys (string)
+  "Substitute key descriptions for command names in STRING.
+Each substring of the form \[COMMAND] is replaced by either a
+keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
+is not on any keys.
+
+Each substring of the form \{MAPVAR} is replaced by a summary of
+the value of MAPVAR as a keymap.  This summary is similar to the one
+produced by `describe-bindings'.  The summary ends in two newlines
+ (used by the helper function `help-make-xrefs' to find the end of the
+      summary).
+
+Each substring of the form \<MAPVAR> specifies the use of MAPVAR
+as the keymap for future \[COMMAND] substrings.
+\= quotes the following character and is discarded;
+thus, \=\= puts \= into the output, and \=\[ puts \[ into the output.
+
+Return the original STRING if no substitutions are made.
+Otherwise, return a new string, without any text properties.
+"
+  (let (ret str mapvar)
+    (if (not ergoemacs-mode)
+        (setq ret (ergoemacs-real-substitute-command-keys string))
+      (with-temp-buffer
+        (insert string)
+        (goto-char (point-min))
+        (while (re-search-forward "\\\\\\(\\[\\|<\\).*?\\(\\]\\|>\\)" nil t)
+          (if (string-match-p "\\`<" (match-string 0))
+              (setq mapvar (match-string 0))
+            (replace-match (ergoemacs-substitute-command (match-string 0) 
mapvar))))
+        (goto-char (point-min))
+        (while (re-search-forward "\\\\{.*?}" nil t)
+          (replace-match (ergoemacs-substitute-map (match-string 0))))
+        (setq ret (buffer-string))))
+    ret))
+
 
 
 
diff --git a/ergoemacs-mode.el b/ergoemacs-mode.el
index 94d99eb..0605965 100644
--- a/ergoemacs-mode.el
+++ b/ergoemacs-mode.el
@@ -79,23 +79,7 @@
   "Print keymap bindings."
   (ergoemacs-debug-heading
    (format "Keymap Description: %s" (symbol-name keymap)))
-  (ergoemacs-debug
-   "|-\n%s"
-   (substring
-    (replace-regexp-in-string
-     "---|\n|-" "---|"
-     (replace-regexp-in-string
-      "^|[ \t]*|$" "|-"
-      (replace-regexp-in-string
-       ".*(that binding is.*\n" ""
-       (replace-regexp-in-string
-        "^" "|"
-        (replace-regexp-in-string
-         "$" "|"
-         (replace-regexp-in-string
-          "\\([ \t]\\{2,\\}\\|\t\\)" "\\1|"
-          (substitute-command-keys (format "\\{%s}" (symbol-name 
keymap)))))))))
-    0 -2)))
+  (ergoemacs-debug (substitute-command-keys (format "\\{%s}" (symbol-name 
keymap)))))
 
 (defvar ergoemacs-debug-heading-start-time (float-time))
 (defvar ergoemacs-debug-heading-last-time (float-time))
diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el
index 9074be3..e2ffeaf 100644
--- a/ergoemacs-theme-engine.el
+++ b/ergoemacs-theme-engine.el
@@ -243,7 +243,7 @@
   (with-slots (deferred-keys) obj
     (let ((deferred-list deferred-list))
       (setq deferred-keys
-          (mapcar
+            (mapcar
            (lambda(x)
              (if (equal (nth 0 x) key)
                  (prog1 (list key deferred-list)
@@ -798,6 +798,12 @@ ergoemacs-get-keymaps-for-hook OBJ HOOK")
 (defmethod ergoemacs-get-keymaps-for-hook ((obj 
ergoemacs-theme-component-map-list) hook &optional ret)
   (ergoemacs-get-hooks obj (concat "\\`" (regexp-quote (symbol-name hook)) 
"\\'") ret t))
 
+(defvar ergoemacs-original-keys-to-shortcut-keys-regexp ""
+  "Regular expression of original keys that have shortcuts.")
+
+(defvar ergoemacs-original-keys-to-shortcut-keys (make-hash-table :test 'equal)
+  "Hash table of the original maps that `ergoemacs-mode' saves.")
+
 (defvar ergoemacs-original-map-hash (make-hash-table)
   "Hash table of the original maps that `ergoemacs-mode' saves.")
 
@@ -3293,8 +3299,10 @@ When NO-MESSAGE is true, don't tell the user."
   ;;; Restore maps
   (ergoemacs-theme-restore-maps no-message)
   (setq ergoemacs-command-shortcuts-hash (make-hash-table :test 'equal)
+        ergoemacs-original-keys-to-shortcut-keys-regexp ""
+        ergoemacs-original-keys-to-shortcut-keys (make-hash-table :test 'equal)
         ergoemacs-extract-map-hash (make-hash-table :test 'equal)
-        ergoemacs-shortcut-function-binding-hash (make-hash-table :test 'equal)
+        ;; ergoemacs-shortcut-function-binding-hash (make-hash-table :test 
'equal)
         ergoemacs-emulation-mode-map-alist '()
         ergoemacs-shortcut-keys nil
         ergoemacs-modal nil
@@ -3370,8 +3378,17 @@ This also:
   (unless dont-install
     (ergoemacs-theme-remove no-message)
     ;; Reset Shortcut hash.
-    (dolist (c ergoemacs-theme-shortcut-reset-list)
-      (puthash (nth 0 c) (nth 1 c) ergoemacs-command-shortcuts-hash))
+    (let (tmp)
+      (dolist (c ergoemacs-theme-shortcut-reset-list)
+        (puthash (nth 0 c) (nth 1 c) ergoemacs-command-shortcuts-hash)
+        (when (eq (nth 1 (nth 1 c)) 'global)
+          (dolist (global-key (ergoemacs-shortcut-function-binding (nth 0 (nth 
1 c))))
+            (if (not (gethash global-key 
ergoemacs-original-keys-to-shortcut-keys))
+                (puthash global-key (append (gethash global-key 
ergoemacs-original-keys-to-shortcut-keys) (list (nth 0 c))) 
ergoemacs-original-keys-to-shortcut-keys)
+              (push (key-description global-key) tmp)
+              (puthash global-key (list (nth 0 c)) 
ergoemacs-original-keys-to-shortcut-keys)))))
+      (setq ergoemacs-original-keys-to-shortcut-keys-regexp
+            (regexp-opt tmp t)))
     (setq ergoemacs-emulation-mode-map-alist '())
     ;; Install persistent mode-based remaps.
     (dolist (mode ergoemacs-theme-mode-based-remaps)
diff --git a/ergoemacs-translate.el b/ergoemacs-translate.el
index 1120313..1314b89 100644
--- a/ergoemacs-translate.el
+++ b/ergoemacs-translate.el
@@ -98,19 +98,26 @@ This assumes `ergoemacs-use-unicode-char' is non-nil.  When
   :type 'boolean
   :group 'ergoemacs-mode)
 
+(defcustom ergoemacs-use-unicode-brackets t
+  "Use unicode brackets."
+  :type 'boolean
+  :group 'ergoemacs-mode)
+
 (defun ergoemacs-pretty-key (code)
   "Creates Pretty keyboard binding from kbd CODE from M- to Alt+"
   (if (not code) ""
     (let (deactivate-mark
+          (ob (or (and ergoemacs-use-unicode-brackets (ergoemacs-unicode-char 
"【" "[")) "["))
+          (cb (or (and ergoemacs-use-unicode-brackets (ergoemacs-unicode-char 
"】" "]")) "]"))
           (ret (replace-regexp-in-string
                 " +$" "" (replace-regexp-in-string "^ +" "" code)))
           (case-fold-search nil)) 
       (when ergoemacs-use-ergoemacs-key-descriptions
         (save-match-data
           (with-temp-buffer
-            (insert (ergoemacs-unicode-char "【" "["))
+            (insert ob)
             (insert ret)
-            (insert (ergoemacs-unicode-char "】" "]"))
+            (insert cb)
             (goto-char (point-min))
             (while (re-search-forward "<f\\([0-9]+\\)>" nil t)
               (replace-match "<F\\1>"))
@@ -126,8 +133,7 @@ This assumes `ergoemacs-use-unicode-char' is non-nil.  When
               (replace-match "S-" t t))
             (goto-char (point-min))
             (while (re-search-forward " +" nil t)
-              (replace-match (format "%s%s"
-                                     (ergoemacs-unicode-char "】" "]") 
(ergoemacs-unicode-char "【" "["))))
+              (replace-match (format "%s%s" cb ob)))
             (goto-char (point-min))
             (while (search-forward "M-" nil t)
               (replace-match (if (eq system-type 'darwin)