[elpa] 68/287: Make the caching more robust

[Matthew Fidler]

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

commit 9342acc1b30b0f2809ce6021e826268ec5292740
Author: Matthew L. Fidler <address@hidden>
Date:   Wed Jun 11 11:08:06 2014 -0500

    Make the caching more robust
---
 ergoemacs-theme-engine.el |  329 +++++++++++++++++++++++++++------------------
 1 files changed, 197 insertions(+), 132 deletions(-)

diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el
index b537a2b..0132158 100644
--- a/ergoemacs-theme-engine.el
+++ b/ergoemacs-theme-engine.el
@@ -265,6 +265,21 @@ a set type."
      :type list))
   "`ergoemacs-mode' fixed-map class")
 
+(defgeneric ergoemacs-copy-obj-keymaps (obj)
+  "Copies OBJECTS keymaps so they are not shared beteween instances.")
+
+(defmethod ergoemacs-copy-obj-keymaps ((obj ergoemacs-fixed-map))
+  (with-slots (read-map
+               shortcut-map
+               no-shortcut-map
+               map
+               unbind-map) obj
+    (oset obj read-map (copy-keymap read-map))
+    (oset obj shortcut-map (copy-keymap shortcut-map))
+    (oset obj no-shortcut-map (copy-keymap no-shortcut-map))
+    (oset obj map (copy-keymap map))
+    (oset obj unbind-map (copy-keymap unbind-map))))
+
 (defmethod ergoemacs-debug-obj ((obj ergoemacs-fixed-map) &optional stars)
   (let ((stars (or stars "**")))
     (with-slots (object-name
@@ -607,6 +622,10 @@ Optionally use DESC when another description isn't found 
in `ergoemacs-function-
     ;; Defining key resets the fixed-maps...
     (oset obj keymap-hash (make-hash-table))))
 
+(defmethod ergoemacs-copy-obj-keymaps ((obj ergoemacs-variable-map))
+  ;; Reset fixed-map calculations.
+  (oset obj keymap-hash (make-hash-table)))
+
 (defmethod ergoemacs-get-fixed-map ((obj ergoemacs-variable-map) &optional 
layout)
   (with-slots (keymap-list
                cmd-list
@@ -707,6 +726,12 @@ Optionally use DESC when another description isn't found 
in `ergoemacs-function-
         (ergoemacs-define-map fixed key def no-unbind))))
   (oset obj keymap-hash (make-hash-table)))
 
+(defmethod ergoemacs-copy-obj-keymaps ((obj ergoemacs-composite-map))
+  (with-slots (fixed variable) obj
+    ;; Copy/Reset fixed/variable keymaps.
+    (ergoemacs-copy-obj-keymaps fixed)
+    (ergoemacs-copy-obj-keymaps variable)))
+
 (defun ergoemacs-get-fixed-map--combine-maps (keymap1 keymap2 &optional parent)
   "Combines KEYMAP1 and KEYMAP2.
 When parent is a keymap, make a composed keymap of KEYMAP1 and KEYMAP2 with 
PARENT keymap
@@ -732,7 +757,7 @@ Assumes maps are orthogonal."
       (pop map2)
       (setq map1 (append map1 map2))
       (push 'keymap map1)
-      map1))))
+      (copy-keymap map1)))))
 
 (defmethod ergoemacs-get-fixed-map ((obj ergoemacs-composite-map) &optional 
layout)
   (ergoemacs-composite-map--ini obj)
@@ -797,6 +822,9 @@ Assumes maps are orthogonal."
    (maps :initarg :fixed
          :initform (make-hash-table)
          :type hash-table)
+   (fixed-maps :initarg :fixed-maps
+               :initform (make-hash-table)
+               :type hash-table)
    (init :initarg :init
          :initform ()
          :type list)
@@ -808,6 +836,23 @@ Assumes maps are orthogonal."
              :type list))
   "`ergoemacs-mode' theme-component maps")
 
+(defmethod ergoemacs-copy-obj-keymaps ((obj ergoemacs-theme-component-maps))
+  (with-slots (global maps) obj
+    (let ((newmaps (make-hash-table)))
+      (ergoemacs-copy-obj-keymaps global)
+      ;; Reset hash
+      (maphash
+       (lambda(key o2)
+         (ergoemacs-copy-obj-keymaps o2)
+         (puthash key o2 newmaps))
+       maps)
+      (oset obj maps newmaps))))
+
+(defmethod ergoemacs-theme-component-maps--save-hash ((obj 
ergoemacs-theme-component-maps))
+  (with-slots (object-name version) obj
+    (puthash (concat object-name (or (and (string= "" version) "") "::") 
version)
+             obj ergoemacs-theme-comp-hash)))
+
 (defmethod ergoemacs-theme-component-maps--ini ((obj 
ergoemacs-theme-component-maps))
   (with-slots (object-name
                variable-reg
@@ -821,7 +866,7 @@ Assumes maps are orthogonal."
              :variable-reg variable-reg
              :just-first just-first
              :layout layout))
-      )))
+      (ergoemacs-theme-component-maps--save-hash obj))))
 
 (defvar ergoemacs-theme-component-maps--always nil)
 (defvar ergoemacs-theme-component-maps--full-map nil)
@@ -837,7 +882,7 @@ Assumes maps are orthogonal."
                just-first
                layout
                maps) obj
-      (let ((ret (gethash keymap maps)))
+    (let ((ret (gethash keymap maps)))
         (unless ret
           (setq ret
                 (ergoemacs-composite-map
@@ -852,18 +897,13 @@ Assumes maps are orthogonal."
               (oset ret hook ergoemacs-theme-component-maps--hook)
             (oset ret hook (intern (save-match-data (replace-regexp-in-string 
"-map.*\\'" "-hook" (symbol-name keymap))))))
           (puthash keymap ret maps)
-          (oset obj maps maps))
+          (oset obj maps maps)
+          (ergoemacs-theme-component-maps--save-hash obj))
         ret)))
 
-(defmethod ergoemacs-theme-component-maps--save-keymap ((obj 
ergoemacs-theme-component-maps) keymap new-map)
-  (ergoemacs-theme-component-maps--ini obj)
-  (with-slots (maps) obj
-    (puthash keymap new-map maps)
-    (oset obj maps maps)))
-
 (defmethod ergoemacs-define-map ((obj ergoemacs-theme-component-maps) keymap 
key def)
   (ergoemacs-theme-component-maps--ini obj)
-  (with-slots (global) obj
+  (with-slots (global maps) obj
     (cond
      ((eq keymap 'global-map)
       (ergoemacs-define-map global key def))
@@ -874,16 +914,24 @@ Assumes maps are orthogonal."
         (if (not (ergoemacs-composite-map-p composite-map))
             (warn "`ergoemacs-define-map' cannot find map for %s" keymap)
           (ergoemacs-define-map composite-map key def)
-          (ergoemacs-theme-component-maps--save-keymap obj keymap 
composite-map)))))))
+          (puthash keymap composite-map maps)
+          (oset obj maps maps)))))
+    (ergoemacs-theme-component-maps--save-hash obj)))
 
 (defmethod ergoemacs-get-fixed-map ((obj ergoemacs-theme-component-maps) 
&optional keymap layout)
   (ergoemacs-theme-component-maps--ini obj)
-  (with-slots (global) obj
-    (cond
-     ((not keymap) (ergoemacs-get-fixed-map global layout))
-     (t
-      (ergoemacs-get-fixed-map
-       (ergoemacs-theme-component-maps--keymap obj keymap) layout)))))
+  (with-slots (global fixed-maps) obj
+    (let* ((ilay (intern (concat (or (and keymap (symbol-name keymap)) 
"global") "-" (or layout ergoemacs-keyboard-layout))))
+           (ret (gethash ilay fixed-maps)))
+      (unless ret
+        (setq ret (cond
+                   ((not keymap) (ergoemacs-get-fixed-map global layout))
+                   (t
+                    (ergoemacs-get-fixed-map
+                     (ergoemacs-theme-component-maps--keymap obj keymap) 
layout))))
+        (puthash ilay ret fixed-maps))
+      (ergoemacs-theme-component-maps--save-hash obj)
+      ret)))
 
 (defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-maps) &optional 
match ret keymaps)
   (ergoemacs-theme-component-maps--ini obj)
@@ -900,11 +948,14 @@ Assumes maps are orthogonal."
        maps))
     ret))
 
-
+(defvar ergoemacs-theme-component-map-list-fixed-hash (make-hash-table :test 
'equal))
 (defclass ergoemacs-theme-component-map-list (ergoemacs-named)
   ((map-list :initarg :map-list
              :initform ()
-             :type list))
+             :type list)
+   (components :initarg :components
+               :initform ()
+               :type list))
   "`ergoemacs-mode' theme-component maps")
 
 (defmethod ergoemacs-get-versions ((obj ergoemacs-theme-component-map-list) )
@@ -1234,7 +1285,6 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
   (goto-char (point-min))
   (call-interactively 'hide-sublevels))
 
-
 
 
 (defun ergoemacs-get-fixed-map--composite (map-list)
@@ -1244,104 +1294,107 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
       (make-sparse-keymap)))
 
 (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))
-          new-global-map-p
-          new-read-map
-          new-read-list
-          new-shortcut-map
-          new-no-shortcut-map
-          new-map
-          new-unbind-map
-          new-shortcut-list
-          new-shortcut-movement
-          new-shortcut-shifted-movement
-          new-rm-keys
-          new-cmd-list
-          new-modify-map
-          new-hook
-          new-full-map
-          new-always
-          new-deferred-keys
-          (first t)
-          ret)
-      (dolist (map-obj fixed-maps)
-       (when (ergoemacs-fixed-map-p map-obj)
-          (with-slots (global-map-p
-                       read-map
-                       read-list
-                       shortcut-map
-                       no-shortcut-map
-                       map
-                       unbind-map
-                       shortcut-list
-                       shortcut-movement
-                       shortcut-shifted-movement
-                       rm-keys
-                       cmd-list
-                       modify-map
-                       full-map
-                       always
-                       deferred-keys) map-obj
-            (unless (equal read-map '(keymap))
-              (push read-map new-read-map))
-            (unless (equal shortcut-map '(keymap))
-              (push shortcut-map new-shortcut-map))
-            (unless (equal no-shortcut-map '(keymap))
-              (push no-shortcut-map new-no-shortcut-map))
-            (unless (equal map '(keymap))
-              (push map new-map))
-            (unless (equal unbind-map '(keymap))
-              (push unbind-map new-unbind-map))
-            (when (slot-boundp map-obj 'hook)
-              (setq new-hook (oref map-obj hook)))
-            (if first
-                (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
-                      new-global-map-p global-map-p
-                      new-modify-map modify-map
-                      new-full-map full-map
-                      new-always always
-                      first nil)
-              (setq new-global-map-p (or new-global-map-p global-map-p)
-                    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)
-                    new-rm-keys (append new-rm-keys rm-keys)
-                    new-cmd-list (append new-cmd-list cmd-list)
-                    new-deferred-keys (append new-deferred-keys 
deferred-keys))))))
-      (setq ret
-            (ergoemacs-fixed-map
-             (or (and keymap (or (and (stringp keymap) keymap)
-                                 (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)
-             :map (ergoemacs-get-fixed-map--composite new-map)
-             :unbind-map (ergoemacs-get-fixed-map--composite new-unbind-map)
-             :shortcut-list new-shortcut-list
-             :shortcut-movement new-shortcut-movement
-             :shortcut-shifted-movement new-shortcut-shifted-movement
-             :rm-keys new-rm-keys
-             :cmd-list new-cmd-list
-             :modify-map new-modify-map
-             :full-map new-full-map
-             :always new-always
-             :deferred-keys new-deferred-keys))
-      (when new-hook
-        (oset ret hook new-hook))
+  (with-slots (map-list components) obj
+    (let* ((key (append (list keymap (or layout ergoemacs-keyboard-layout)) 
components))
+           (ret (gethash key ergoemacs-theme-component-map-list-fixed-hash)))
+      (unless ret
+        (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
+              new-unbind-map
+              new-shortcut-list
+              new-shortcut-movement
+              new-shortcut-shifted-movement
+              new-rm-keys
+              new-cmd-list
+              new-modify-map
+              new-hook
+              new-full-map
+              new-always
+              new-deferred-keys
+              (first t))
+          (dolist (map-obj fixed-maps)
+            (when (ergoemacs-fixed-map-p map-obj)
+              (with-slots (global-map-p
+                           read-map
+                           read-list
+                           shortcut-map
+                           no-shortcut-map
+                           map
+                           unbind-map
+                           shortcut-list
+                           shortcut-movement
+                           shortcut-shifted-movement
+                           rm-keys
+                           cmd-list
+                           modify-map
+                           full-map
+                           always
+                           deferred-keys) map-obj
+                (unless (equal read-map '(keymap))
+                  (push read-map new-read-map))
+                (unless (equal shortcut-map '(keymap))
+                  (push shortcut-map new-shortcut-map))
+                (unless (equal no-shortcut-map '(keymap))
+                  (push no-shortcut-map new-no-shortcut-map))
+                (unless (equal map '(keymap))
+                  (push map new-map))
+                (unless (equal unbind-map '(keymap))
+                  (push unbind-map new-unbind-map))
+                (when (slot-boundp map-obj 'hook)
+                  (setq new-hook (oref map-obj hook)))
+                (if first
+                    (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
+                          new-global-map-p global-map-p
+                          new-modify-map modify-map
+                          new-full-map full-map
+                          new-always always
+                          first nil)
+                  (setq new-global-map-p (or new-global-map-p global-map-p)
+                        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)
+                        new-rm-keys (append new-rm-keys rm-keys)
+                        new-cmd-list (append new-cmd-list cmd-list)
+                        new-deferred-keys (append new-deferred-keys 
deferred-keys))))))
+          (setq ret
+                (ergoemacs-fixed-map
+                 (or (and keymap (or (and (stringp keymap) keymap)
+                                     (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)
+                 :map (ergoemacs-get-fixed-map--composite new-map)
+                 :unbind-map (ergoemacs-get-fixed-map--composite 
new-unbind-map)
+                 :shortcut-list new-shortcut-list
+                 :shortcut-movement new-shortcut-movement
+                 :shortcut-shifted-movement new-shortcut-shifted-movement
+                 :rm-keys new-rm-keys
+                 :cmd-list new-cmd-list
+                 :modify-map new-modify-map
+                 :full-map new-full-map
+                 :always new-always
+                 :deferred-keys new-deferred-keys))
+          (when new-hook
+            (oset ret hook new-hook))
+          (puthash key ret ergoemacs-theme-component-map-list-fixed-hash)))
       ret)))
 
 
@@ -1385,7 +1438,9 @@ The actual keymap changes are included in 
`ergoemacs-emulation-mode-map-alist'."
     (setq ergoemacs-theme-component-maps--curr-component
           (clone ergoemacs-theme-component-maps--curr-component))
     (oset ergoemacs-theme-component-maps--curr-component
-          version version)))
+          version version)
+    ;; Copy keymaps
+    (ergoemacs-copy-obj-keymaps 
ergoemacs-theme-component-maps--curr-component)))
 
 (defun ergoemacs-theme-component--with-hook (hook plist body)
   ;; Adapted from Stefan Monnier
@@ -1576,11 +1631,7 @@ additional parsing routines defined by PARSE-FUNCTION."
           (push tmp ver-list)))
       (dolist (comp ergoemacs-theme-component-maps--versions)
         (oset comp versions ver-list)
-        (setq tmp (oref comp version))
-        (unless (string= tmp "")
-          (setq tmp (concat "::" tmp)))
-        (puthash (concat (oref comp object-name) tmp)
-                 comp ergoemacs-theme-comp-hash)))))
+        (ergoemacs-theme-component-maps--save-hash comp)))))
 
 (defvar ergoemacs-theme-comp-hash (make-hash-table :test 'equal)
   "Hash of ergoemacs theme components")
@@ -1591,9 +1642,10 @@ additional parsing routines defined by PARSE-FUNCTION."
   (let ((kb (make-symbol "body-and-plist")))
     (setq kb (ergoemacs-theme-component--parse body-and-plist))
     `(puthash ,(plist-get (nth 0 kb) ':name)
-              (lambda() (ergoemacs-theme-component--create-component
-                         ',(nth 0 kb)
-                         '(lambda () ,@(nth 1 kb)))) 
ergoemacs-theme-comp-hash)))
+              (lambda() ,(plist-get (nth 0 kb) ':description)
+                (ergoemacs-theme-component--create-component
+                 ',(nth 0 kb)
+                 '(lambda () ,@(nth 1 kb)))) ergoemacs-theme-comp-hash)))
 
 (defmacro ergoemacs-theme (&rest body-and-plist)
   "Define an ergoemacs-theme.
@@ -1681,12 +1733,26 @@ Formatted for use with `ergoemacs-theme-component-hash' 
it will return ::version
           ret)
       "")))
 
+(defun ergoemacs-theme-get-component-description (component)
+  "Gets the description of a COMPONENT.
+Allows the component not to be calculated."
+  (let* ((comp-name (or (and (symbolp component) (symbol-name component))
+                        component))
+         (comp (gethash comp-name ergoemacs-theme-comp-hash)))
+    (cond
+     ((functionp comp)
+      (documentation comp))
+     ((ergoemacs-theme-component-maps-p comp)
+      (oref comp description))
+     (t ""))))
+
 (defun ergoemacs-theme-get-component (component &optional version name)
   "Gets the VERSION of COMPONENT from `ergoemacs-theme-comp-hash'.
 COMPONENT can be defined as component::version"
   (if (listp component)
       (ergoemacs-theme-component-map-list
-       (or name "list") :map-list (mapcar (lambda(comp) 
(ergoemacs-theme-get-component comp version)) component))    
+       (or name "list") :map-list (mapcar (lambda(comp) 
(ergoemacs-theme-get-component comp version)) component)
+       :components component)
     (let* ((comp-name (or (and (symbolp component) (symbol-name component))
                           component))
            (version (or (and (symbolp version) (symbol-name version))
@@ -1982,7 +2048,7 @@ If OFF is non-nil, turn off the options instead."
               (when (memq option (append options-on options-off))
                 ;; (setq plist2 (gethash (concat (symbol-name option) 
":plist") ergoemacs-theme-component-hash))
                 ;; (setq desc (plist-get plist2 ':description))
-                (setq desc (oref (ergoemacs-theme-get-component (symbol-name 
option)) description))
+                (setq desc (ergoemacs-theme-get-component-description 
(symbol-name option)))
                 (push option menu-options)
                 (push
                  `(,option
@@ -2006,8 +2072,7 @@ If OFF is non-nil, turn off the options instead."
       (mapc
        (lambda(option)
          (unless (member option menu-options)
-           (let (;; (plist2 (gethash (concat (symbol-name option) ":plist") 
ergoemacs-theme-component-hash))
-                 (desc (oref (ergoemacs-theme-get-component (symbol-name 
option)) description)))
+           (let ((desc (ergoemacs-theme-get-component-description (symbol-name 
option))))
              (push desc options-list)
              (push (list desc option) options-alist))))
        (append options-on options-off))