[elpa] 65/287: Add more emulation alists. Less list manipulation

[Matthew Fidler]

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

commit a8ed050f801b5f7910068f280dde527a7f0ee39d
Author: Matthew L. Fidler <address@hidden>
Date:   Mon Jun 9 14:03:12 2014 -0500

    Add more emulation alists. Less list manipulation
---
 ergoemacs-functions.el    |   13 ++++++
 ergoemacs-modal.el        |    6 ++-
 ergoemacs-mode.el         |   94 +++++++++++++++-----------------------------
 ergoemacs-shortcuts.el    |   27 ++++++++-----
 ergoemacs-theme-engine.el |   62 +++++++++++++++++++++---------
 5 files changed, 110 insertions(+), 92 deletions(-)

diff --git a/ergoemacs-functions.el b/ergoemacs-functions.el
index f12ab77..a4d5df7 100644
--- a/ergoemacs-functions.el
+++ b/ergoemacs-functions.el
@@ -2083,10 +2083,23 @@ See also `ergoemacs-lookup-word-on-internet'."
   (insert (format "ergoemacs-mode %s\n" ergoemacs-mode))
   (insert (format "ergoemacs-save-variables-state %s\n" 
ergoemacs-save-variables-state))
   (insert (format "emulation-mode-map-alists: %s\n" emulation-mode-map-alists))
+  (insert (format "ergoemacs-read-emulation-mode-map-alist: %s\n"
+                  (mapcar
+                   (lambda(x) (nth 0 x))
+                   ergoemacs-read-emulation-mode-map-alist)))
+  (insert (format "ergoemacs-modal-emulation-mode-map-alist: %s\n"
+                  (mapcar
+                   (lambda(x) (nth 0 x))
+                   ergoemacs-modal-emulation-mode-map-alist)))
+  (insert (format "ergoemacs-repeat-emulation-mode-map-alist: %s\n"
+                  (mapcar
+                   (lambda(x) (nth 0 x))
+                   ergoemacs-repeat-emulation-mode-map-alist)))
   (insert (format "ergoemacs-emulation-mode-map-alist: %s\n"
                    (mapcar
                     (lambda(x) (nth 0 x))
                     ergoemacs-emulation-mode-map-alist)))
+  
   (insert (format "minor-mode-map-alist: %s\n"
                    (mapcar
                     (lambda(x) (nth 0 x))
diff --git a/ergoemacs-modal.el b/ergoemacs-modal.el
index 0269322..4a65f4c 100644
--- a/ergoemacs-modal.el
+++ b/ergoemacs-modal.el
@@ -387,7 +387,8 @@ Typically function keys")
             (make-composed-keymap
              (list (ergoemacs-local-map type t)
                    (ergoemacs-modal-base-keymap))))
-      (ergoemacs-add-emulation)
+      (setq ergoemacs-modal-emulation-mode-map-alist
+            `((ergoemacs-modal ,@ergoemacs-modal-keymap)))
       (set-default 'ergoemacs-modal type)
       (setq ergoemacs-modal type)
       (unless ergoemacs-default-cursor
@@ -419,7 +420,8 @@ Typically function keys")
                   (make-composed-keymap
                    (list (ergoemacs-local-map type t)
                          (ergoemacs-modal-base-keymap))))
-            (ergoemacs-add-emulation)
+            (setq ergoemacs-modal-emulation-mode-map-alist
+                  `((ergoemacs-modal ,@ergoemacs-modal-keymap)))
             (set-default 'ergoemacs-modal type)
             (setq ergoemacs-modal type)
             (unless ergoemacs-default-cursor
diff --git a/ergoemacs-mode.el b/ergoemacs-mode.el
index 4636d90..df87470 100644
--- a/ergoemacs-mode.el
+++ b/ergoemacs-mode.el
@@ -243,59 +243,19 @@ Valid values are:
         ergoemacs-repeat-keys
         ergoemacs-read-input-keys
         (keymap (make-sparse-keymap)))
-    (mapc
-     (lambda(key)
-       (when (= 1 (length key))
-         (let ((mods (event-modifiers (elt key 0))))
-           (when (memq 'meta mods)
-             (define-key keymap
-               (vector
-                (event-convert-list
-                 (append (delete 'meta mods)
-                         (list (event-basic-type (elt key 0))))))
-               `(lambda() (interactive) (ergoemacs-read-key ,(key-description 
key))))))))
-     (append (where-is-internal 'ergoemacs-shortcut-movement)
-             (where-is-internal 'ergoemacs-shortcut-movement-no-shift-select)))
+    (dolist (key (append (where-is-internal 'ergoemacs-shortcut-movement)
+                         (where-is-internal 
'ergoemacs-shortcut-movement-no-shift-select)))
+      (when (= 1 (length key))
+        (let ((mods (event-modifiers (elt key 0))))
+          (when (memq 'meta mods)
+            (define-key keymap
+              (vector
+               (event-convert-list
+                (append (delete 'meta mods)
+                        (list (event-basic-type (elt key 0))))))
+              `(lambda() (interactive) (ergoemacs-read-key ,(key-description 
key))))))))
     keymap))
 
-
-(when (not (fboundp 'set-temporary-overlay-map))
-  ;; Backport this function from newer emacs versions
-  (defun set-temporary-overlay-map (map &optional keep-pred)
-    "Set a new keymap that will only exist for a short period of time.
-The new keymap to use must be given in the MAP variable. When to
-remove the keymap depends on user input and KEEP-PRED:
-
-- if KEEP-PRED is nil (the default), the keymap disappears as
-  soon as any key is pressed, whether or not the key is in MAP;
-
-- if KEEP-PRED is t, the keymap disappears as soon as a key *not*
-  in MAP is pressed;
-
-- otherwise, KEEP-PRED must be a 0-arguments predicate that will
-  decide if the keymap should be removed (if predicate returns
-  nil) or kept (otherwise). The predicate will be called after
-  each key sequence."    
-    (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
-           (overlaysym (make-symbol "t"))
-           (alist (list (cons overlaysym map)))
-           (clearfun
-            `(lambda ()
-               (unless ,(cond ((null keep-pred) nil)
-                              ((eq t keep-pred)
-                               `(eq this-command
-                                    (lookup-key ',map
-                                                (this-command-keys-vector))))
-                              (t `(funcall ',keep-pred)))
-                 (remove-hook 'pre-command-hook ',clearfunsym)
-                 (setq emulation-mode-map-alists
-                       (delq ',alist emulation-mode-map-alists))))))
-      (set overlaysym overlaysym)
-      (fset clearfunsym clearfun)
-      (add-hook 'pre-command-hook clearfunsym)
-      
-      (push alist emulation-mode-map-alists))))
-
 (defvar ergoemacs-curr-prefix-arg nil)
 (defvar ergoemacs-repeat-keys nil)
 (defvar ergoemacs-shortcut-keys nil)
@@ -412,8 +372,26 @@ remove the keymap depends on user input and KEEP-PRED:
 (defvar ergoemacs-save-variables-actual nil)
 (defvar ergoemacs-save-variables-state nil)
 
+(defvar ergoemacs-modal-emulation-mode-map-alist nil
+  "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'")
+
+(defvar ergoemacs-repeat-emulation-mode-map-alist nil
+  "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'")
+
+(defvar ergoemacs-read-emulation-mode-map-alist nil
+  "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'")
+
 (defvar ergoemacs-emulation-mode-map-alist nil
-  "Override keys in ergoemacs-mode for `emulation-mode-map-alist'")
+  "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'")
+
+(defun ergoemacs-emulations (&optional remove)
+  "Add ergoemacs emulations to `emulation-mode-map-alist'.
+When REMOVE is true, remove the emulations."
+  (dolist (hook (reverse '(ergoemacs-modal-emulation-mode-map-alist
+                           ergoemacs-read-emulation-mode-map-alist
+                           ergoemacs-repeat-emulation-mode-map-alist
+                           ergoemacs-emulation-mode-map-alist)))
+    (funcall (if remove #'remove-hook #'add-hook) #'emulation-mode-map-alists 
hook)))
 
 ;; ErgoEmacs minor mode
 ;;;###autoload
@@ -454,12 +432,7 @@ bindings the keymap is:
         ;; (if (boundp 'org-CUA-compatible)
         ;;     (setq ergoemacs-org-CUA-compatible nil)
         ;;   (setq ergoemacs-org-CUA-compatible org-CUA-compatible))
-        ;; From yasnippet:
-        ;; Install the direct keymaps in `emulation-mode-map-alists'
-        ;; (we use `add-hook' even though it's not technically a hook,
-        ;; but it works). Then define variables named after modes to
-        ;; index `ergoemacs-emulation-mode-map-alist'.
-        (add-hook 'emulation-mode-map-alists 
'ergoemacs-emulation-mode-map-alist)
+        (ergoemacs-emulations)
         ;; Setup keys
         (setq ergoemacs-shortcut-keymap (make-sparse-keymap))
         (ergoemacs-setup-keys t)
@@ -722,10 +695,7 @@ This is added to `ergoemacs-emulation-mode-map-alist' 
while keeping the order co
     (when (listp keymap-list)
       (setq small-emulation (append keymap-list small-emulation)))
     (setq ergoemacs-emulation-mode-map-alist
-          `((ergoemacs-modal ,@(or ergoemacs-modal-keymap 
(make-sparse-keymap)))
-            (ergoemacs-repeat-keys ,@(or ergoemacs-repeat-keymap 
(make-sparse-keymap)))
-            (ergoemacs-read-input-keys ,@(or ergoemacs-read-input-keymap 
(make-sparse-keymap)))
-            ,@small-emulation
+          `(,@small-emulation
             (ergoemacs-shortcut-keys ,@(or ergoemacs-shortcut-keymap 
(make-sparse-keymap)))))))
 
 (defun ergoemacs-shuffle-keys (&optional var keymap keymap-list)
diff --git a/ergoemacs-shortcuts.el b/ergoemacs-shortcuts.el
index fb4339d..0898a94 100644
--- a/ergoemacs-shortcuts.el
+++ b/ergoemacs-shortcuts.el
@@ -113,7 +113,7 @@ The global map is ignored, but major/minor modes keymaps 
are included."
        (use-global-map old-global-map))))
 
 (defmacro ergoemacs-without-emulation (&rest body)
-  "Without keys defined at `ergoemacs-emulation-mode-map-alist'.
+  "Without keys defined at `emulation-mode-map-alists'.
 
 Also temporarily remove any changes ergoemacs-mode made to:
 - `overriding-terminal-local-map'
@@ -126,7 +126,7 @@ installing the original keymap above the ergoemacs-mode 
installed keymap.
          (overriding-local-map overriding-local-map)
          lookup tmp-overlay override-text-map)
      ;; Remove most of ergoemacs-mode's key bindings
-     (remove-hook 'emulation-mode-map-alists 
'ergoemacs-emulation-mode-map-alist)
+     (ergoemacs-emulations 'remove)
      (unwind-protect
          (progn
            ;; Install override-text-map changes above anything already
@@ -136,7 +136,7 @@ installing the original keymap above the ergoemacs-mode 
installed keymap.
        (when tmp-overlay
          (delete-overlay tmp-overlay))
        (when ergoemacs-mode
-         (add-hook 'emulation-mode-map-alists 
'ergoemacs-emulation-mode-map-alist)))))
+         (ergoemacs-emulations)))))
 
 (defgroup ergoemacs-read nil
   "Options for ergoemacs-read-key."
@@ -1234,12 +1234,10 @@ argument prompt.
                          (push (concat key-base "-et") key-trials)))
                      (ergoemacs-shortcut-function-binding (nth 0 tmp)))))
                 (when ergoemacs-translate-keys
-                  (mapc
-                   (lambda(trial)
-                     (push trial key-trials)
-                     (setq next-key (ergoemacs-read-key-add-translation 
next-key trial))
-                     (push (concat trial "-et") key-trials))
-                   '(":raw" ":ctl" ":alt" ":alt-ctl" ":raw-shift" ":ctl-shift" 
":alt-shift" ":alt-ctl-shift")))
+                  (dolist (trial '(":raw" ":ctl" ":alt" ":alt-ctl" 
":raw-shift" ":ctl-shift" ":alt-shift" ":alt-ctl-shift"))
+                    (push trial key-trials)
+                    (setq next-key (ergoemacs-read-key-add-translation 
next-key trial))
+                    (push (concat trial "-et") key-trials)))
                 (setq key-trials (reverse key-trials))
                 (unless
                     (catch 'ergoemacs-key-trials
@@ -1399,6 +1397,14 @@ argument prompt.
           ergoemacs-mark-active nil))
   (setq ergoemacs-describe-key nil))
 
+(defun ergoemacs-read-key-default (&optional arg)
+  "The default command for `ergoemacs-mode' read-key.
+It sends `this-single-command-keys' to `ergoemacs-read-key' with
+no translation listed."
+  (interactive "^P")
+  (ergoemacs-read-key
+   (or ergoemacs-single-command-keys (this-single-command-keys))))
+
 
 
 (defvar ergoemacs-ignored-prefixes '(;; "C-h" "<f1>"
@@ -1476,7 +1482,8 @@ Basically, this gets the keys called and passes the 
arguments to`ergoemacs-read-
 (defun ergoemacs-install-repeat-keymap (keymap &optional mode-line)
   "Installs repeat KEYMAP."
   (setq ergoemacs-repeat-keymap keymap)
-  (ergoemacs-add-emulation)
+  (setq ergoemacs-repeat-emulation-mode-map-alist
+        (list (cons 'ergoemacs-repeat-keys ergoemacs-repeat-keymap)))
   (setq ergoemacs-repeat-keys t)
   (when mode-line
     (ergoemacs-mode-line mode-line)))
diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el
index 1246e5a..8b9b688 100644
--- a/ergoemacs-theme-engine.el
+++ b/ergoemacs-theme-engine.el
@@ -219,6 +219,9 @@ a set type."
    (read-map :initarg :read-map
              :initform (make-sparse-keymap)
              :type keymap)
+   (read-list :initarg :read-list
+              :initform ()
+              :type list)
    (shortcut-map :initarg :shortcut-map
                  :initform (make-sparse-keymap)
                  :type keymap)
@@ -323,12 +326,12 @@ a set type."
     (let ((deferred-list deferred-list))
       (setq deferred-keys
             (mapcar
-           (lambda(x)
-             (if (equal (nth 0 x) key)
-                 (prog1 (list key deferred-list)
-                   (setq deferred-list nil))
-               x))
-           deferred-keys))
+             (lambda(x)
+               (if (equal (nth 0 x) key)
+                   (prog1 (list key deferred-list)
+                     (setq deferred-list nil))
+                 x))
+             deferred-keys))
       (when deferred-list
         (push (list key (reverse deferred-list)) deferred-keys))
       (oset obj deferred-keys deferred-keys))))
@@ -362,15 +365,15 @@ Optionally use DESC when another description isn't found 
in `ergoemacs-function-
 (defmethod ergoemacs-define-map--read-map ((obj ergoemacs-fixed-map) key)
   "Defines KEY in the OBJ read-key slot if it is a vector over 2.
 Key sequences starting with `ergoemacs-ignored-prefixes' are not added."
-  (with-slots (read-map) obj
+  (with-slots (read-map
+               read-list) obj
     (when (< 1 (length key))
       (let* ((new-key (substring key 0 1))
              (kd (key-description new-key)))
         (unless (member kd ergoemacs-ignored-prefixes)
-          (define-key read-map new-key
-            `(lambda()
-               (interactive)
-               (ergoemacs-read-key ,kd 'normal)))
+          (push new-key read-list)
+          (oset obj read-list read-list)
+          (define-key read-map new-key #'ergoemacs-read-key-default)
           (oset obj read-map read-map))))))
 
 (defgeneric ergoemacs-define-map (obj key def &optional no-unbind)
@@ -423,7 +426,9 @@ DEF is anything that can be a key's definition:
                rm-keys
                shortcut-movement
                global-map-p
-               shortcut-shifted-movement) obj
+               shortcut-shifted-movement
+               read-list
+               read-map) obj
     (let* ((key-desc (key-description key))
            (key-vect (read-kbd-macro key-desc t))
            swapped
@@ -472,8 +477,10 @@ DEF is anything that can be a key's definition:
         ;; Normal command
         (if (memq def '(ergoemacs-ctl-c ergoemacs-ctl-x))
             (progn
-              (define-key shortcut-map key-vect def)
-              (oset obj shortcut-map shortcut-map))
+              (push (list key-vect def) read-list)
+              (define-key read-map key-vect def)
+              (oset obj read-map read-map)
+              (oset obj read-list read-list))
           (define-key map key-vect def)
           (oset obj map map))
         (ergoemacs-define-map--cmd-list obj key-desc def))
@@ -730,18 +737,28 @@ Assumes maps are orthogonal."
   (with-slots (variable object-name fixed modify-map full-map always
                         global-map-p keymap-hash) obj
     (let* ((lay (or layout ergoemacs-keyboard-layout))
+           read
            (ilay (intern lay))
            (ret (gethash ilay keymap-hash))
            (fix fixed) map1 map2 var)
       (unless ret ;; Calculate
         (setq var (ergoemacs-get-fixed-map variable lay))
+        (setq read (copy-keymap (oref fix read-map)))
+        ;; This way the read-map is not a composite map.
+        (dolist (key (oref var read-list)) 
+          (cond
+           ((vectorp key)
+            (define-key read key #'ergoemacs-read-key-default))
+           ((and (listp key) (vectorp (nth 0 key)))
+            (define-key read (nth 0 key) (nth 1 key)))))
         (setq ret (ergoemacs-fixed-map
                    lay
                    :global-map-p global-map-p
                    :modify-map modify-map
                    :full-map full-map
                    :always always
-                   :read-map (ergoemacs-get-fixed-map--combine-maps (oref var 
read-map) (oref fix read-map))
+                   :read-map read
+                   :read-list (append (oref var read-list) (oref fix 
read-list))
                    :shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref 
var shortcut-map) (oref fix shortcut-map))
                    :no-shortcut-map (ergoemacs-get-fixed-map--combine-maps 
(oref var no-shortcut-map) (oref fix no-shortcut-map))
                    :map (ergoemacs-get-fixed-map--combine-maps (oref var map) 
(oref fix map))
@@ -1214,6 +1231,7 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
     (let ((fixed-maps (mapcar (lambda(map) (and map (ergoemacs-get-fixed-map 
map keymap layout))) map-list))
           new-global-map-p
           new-read-map
+          new-read-list
           new-shortcut-map
           new-no-shortcut-map
           new-map
@@ -1234,6 +1252,7 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
        (when (ergoemacs-fixed-map-p map-obj)
           (with-slots (global-map-p
                        read-map
+                       read-list
                        shortcut-map
                        no-shortcut-map
                        map
@@ -1263,6 +1282,7 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
                 (setq new-shortcut-list shortcut-list
                       new-shortcut-movement shortcut-movement
                       new-shortcut-shifted-movement shortcut-shifted-movement
+                      new-read-list read-list
                       new-rm-keys rm-keys
                       new-cmd-list cmd-list
                       new-deferred-keys deferred-keys
@@ -1275,6 +1295,7 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
                     new-modify-map (or new-modify-map modify-map)
                     new-full-map (or new-full-map full-map)
                     new-always (or new-always always)
+                    new-read-list (append new-read-list read-list)
                     new-shortcut-list (append new-shortcut-list shortcut-list)
                     new-shortcut-movement (append new-shortcut-movement 
shortcut-movement)
                     new-shortcut-shifted-movement (append 
new-shortcut-shifted-movement shortcut-shifted-movement)
@@ -1287,6 +1308,7 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
                                  (and (symbolp keymap) (symbol-name keymap))))
                  "composite")
              :global-map-p new-global-map-p
+             :read-list new-read-list
              :read-map (ergoemacs-get-fixed-map--composite new-read-map)
              :shortcut-map  (ergoemacs-get-fixed-map--composite 
new-shortcut-map) 
              :no-shortcut-map (ergoemacs-get-fixed-map--composite 
new-no-shortcut-map)
@@ -3626,11 +3648,13 @@ When NO-MESSAGE is true, don't tell the user."
                (set map-name (copy-keymap orig-map))))))))
    ergoemacs-theme-hook-installed))
 
+
+
 (defun ergoemacs-theme-remove (&optional no-message)
   "Remove the currently installed theme and reset to emacs keys.
 When NO-MESSAGE is true, don't tell the user."
   (ergoemacs-theme-make-hooks ergoemacs-theme 'remove-hooks)
-  (remove-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist)
+  (ergoemacs-emulations 'remove)
   ;;; Restore maps
   (ergoemacs-theme-restore-maps no-message)
   (setq ergoemacs-command-shortcuts-hash (make-hash-table :test 'equal)
@@ -3746,6 +3770,9 @@ This also:
     ;; `ergoemacs-read-input-keymap', then `ergoemacs-shortcut-keymap'
     ;; in `ergoemacs-emulation-mode-map-alist'
     (ergoemacs-add-emulation)
+    (add-hook 'emulation-mode-map-alists 
'ergoemacs-modal-emulation-mode-map-alist)
+    (add-hook 'emulation-mode-map-alists 
'ergoemacs-repeat-emulation-mode-map-alist)
+    (add-hook 'emulation-mode-map-alists 
'ergoemacs-read-emulation-mode-map-alist)
     (add-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist)
     (ergoemacs-theme-make-hooks ergoemacs-theme)
     (set-default 'ergoemacs-mode t)
@@ -3824,8 +3851,7 @@ This also:
     (ergoemacs-theme-remove-key-list
      (if (nth 5 tc)
          (append (nth 5 tc) ergoemacs-global-override-rm-keys)
-       ergoemacs-global-override-rm-keys))
-    (setq ergoemacs-M-x (substitute-command-keys "\\[execute-extended-command] 
"))))
+       ergoemacs-global-override-rm-keys))))
 
 (defvar ergoemacs-theme-hash (make-hash-table :test 'equal))