[elpa] 39/287: Starting applying keymaps to ergoemacs-emulation-mode-map-alist

[Matthew Fidler]

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

commit 0d80fcc2bc43a28cca4475f4a91796c94a6cf633
Author: Matthew L. Fidler <address@hidden>
Date:   Wed Jun 4 08:09:16 2014 -0500

    Starting applying keymaps to ergoemacs-emulation-mode-map-alist
---
 ergoemacs-theme-engine.el |   79 +++++++++++++++++++++++++++++++++++++++------
 1 files changed, 69 insertions(+), 10 deletions(-)

diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el
index 7c6e216..48de7fe 100644
--- a/ergoemacs-theme-engine.el
+++ b/ergoemacs-theme-engine.el
@@ -251,7 +251,7 @@
                x))
            deferred-keys))
       (when deferred-list
-        (push (list key deferred-list) deferred-keys))
+        (push (list key (reverse deferred-list)) deferred-keys))
       (oset obj deferred-keys deferred-keys))))
 
 (defmethod ergoemacs-define-map--cmd-list ((obj ergoemacs-fixed-map) key-desc 
def &optional desc)
@@ -383,7 +383,7 @@ DEF is anything that can be a key's definition:
         (ergoemacs-define-map--cmd-list obj key-desc def)
         (define-key map key-vect def)
         (oset obj map map))
-       ((and (listp def) (stringp (nth 0 def)))
+       ((and (listp def) (or (stringp (nth 0 def))))
         ;; `ergoemacs-read-key' shortcut
         (ergoemacs-define-map--shortcut-list obj key-vect def)
         (ergoemacs-define-map--cmd-list obj key-desc def (nth 0 def))
@@ -652,9 +652,6 @@ Assumes maps are orthogonal."
         (oset ret hook (oref obj hook)))
       ret)))
 
-
-
-
 (defclass ergoemacs-theme-component-maps (eieio-named)
   ((variable-reg :initarg :variable-reg
                  :initform (concat "\\(?:^\\|<\\)" (regexp-opt '("M-" "<apps>" 
"<menu>")))
@@ -764,7 +761,7 @@ Assumes maps are orthogonal."
      (t (ergoemacs-get-fixed-map
          (ergoemacs-theme-component-maps--keymap obj keymap) layout)))))
 
-(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-maps) &optional 
match ret)
+(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-maps) &optional 
match ret keymaps)
   (ergoemacs-theme-component-maps--ini obj)
   (let ((ret (or ret '()))
         (match (or match "-hook\\'")))
@@ -772,7 +769,9 @@ Assumes maps are orthogonal."
       (dolist (map-obj maps)
         (when (and (slot-boundp map-obj 'hook)
                    (string-match-p match (symbol-name (oref map-obj hook))))
-          (pushnew (oref map-obj hook) ret))))
+          (if keymaps
+              (pushnew (oref map-obj object-name) ret)
+            (pushnew (oref map-obj hook) ret)))))
     ret))
 
 
@@ -782,14 +781,74 @@ Assumes maps are orthogonal."
              :type list))
   "`ergoemacs-mode' theme-component maps")
 
-(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-map-list) 
&optional match ret)
+(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-map-list) 
&optional match ret keymaps)
   (with-slots (map-list) obj
     (let ((ret (or ret '())))
       (dolist (map map-list)
         (when (ergoemacs-theme-component-maps-p map)
-          (setq ret (ergoemacs-get-hooks map match ret))))
+          (setq ret (ergoemacs-get-hooks map match ret keymaps))))
       ret)))
 
+(defgeneric ergoemacs-get-keymaps-for-hook (obj hook &optional ret)
+  "Gets the keymaps that will be modified for HOOK.
+
+Call:
+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-map-hash (make-hash-table)
+  "Hash table of the original maps that `ergoemacs-mode' saves.")
+
+(defmethod ergoemacs-apply-keymaps-for-hook ((obj 
ergoemacs-theme-component-map-list) hook)
+  (with-slots (shortcut-list) (ergoemacs-get-fixed-map obj)
+      (dolist (map-name (ergoemacs-get-keymaps-for-hook obj hook))
+        (with-slots (map
+                     full-map
+                     always
+                     modify-map) (ergoemacs-get-fixed-map obj map-name)
+          (cond
+           (modify-map
+            (if (not (keymapp (symbol-value map-name)))
+                (warn "Keymap %s not found.  Ergoemacs-mode cannot correct." 
keymap-name)
+              (unless (gethash map-name ergoemacs-original-map-hash)
+                ;; Save original map.
+                (puthash map-name (copy-keymap (symbol-value map-name)) 
ergoemacs-original-map-hash))
+              ;; Now apply map changes.
+              ))
+           (t 
+            ;; Shortcuts are handled by the shortcut layer.
+            (let ((emulation-var (intern (concat "ergoemacs--for-" 
(symbol-name hook) "-with-" (symbol-name map-name))))
+                  x)
+              (unless (boundp emulation-var)
+                (set-default emulation-var nil))
+              (set (make-local-variable emulation-var) t)
+              (setq x (assq emulation-var ergoemacs-emulation-mode-map-alist))
+              (when (or (not x) always)
+                (ergoemacs-shuffle-keys
+                 emulation-var (oref (ergoemacs-get-fixed-map obj map-name) 
map))))))))))
+
+(defgeneric ergoemacs-create-hooks ()
+  "Create and add/remove hooks for `ergoemacs-theme-component-map-list' object.
+
+Call:
+ergoemacs-create-hooks OBJ REMOVE-P
+
+When REMOVE-P is non-nil, remove hooks
+
+")
+
+(defmethod ergoemacs-create-hooks ((obj ergoemacs-theme-component-map-list) 
remove-p)
+  (dolist (hook (ergoemacs-get-hooks obj))
+    (fset (intern (concat "ergoemacs-for-" (symbol-name hook)))
+          `(lambda ()
+             ,(format "Run `ergoemacs-theme-hook' for `%s'"
+                      (symbol-name hook))
+             (ergoemacs-theme-hook ',hook)))
+    (funcall (if remove-p #'remove-hook #'add-hook) hook
+             (intern (concat "ergoemacs-for-" (symbol-name hook))))))
+
 (defmethod ergoemacs-get-fixed-map ((obj ergoemacs-theme-component-map-list) 
&optional keymap layout)
   (with-slots (map-list) obj
     (let ((fixed-maps (mapcar (lambda(map) (and map (ergoemacs-get-fixed-map 
map keymap layout))) map-list))
@@ -812,7 +871,7 @@ Assumes maps are orthogonal."
           (first t)
           ret)
       (dolist (map-obj fixed-maps)
-        (when (ergoemacs-fixed-map-p map-obj)
+       (when (ergoemacs-fixed-map-p map-obj)
           (with-slots (global-map-p
                        read-map
                        shortcut-map