[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 68/287: Make the caching more robust
From: |
Matthew Fidler |
Subject: |
[elpa] 68/287: Make the caching more robust |
Date: |
Wed, 02 Jul 2014 14:44:41 +0000 |
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))
- [elpa] 61/287: Ergoemacs-mode setup with object almost complete., (continued)
- [elpa] 61/287: Ergoemacs-mode setup with object almost complete., Matthew Fidler, 2014/07/02
- [elpa] 66/287: Make ergoemacs-clean toggle debug on error, Matthew Fidler, 2014/07/02
- [elpa] 71/287: Fix isearch issues., Matthew Fidler, 2014/07/02
- [elpa] 60/287: Ensure the object-name is a string. EIEIO seems to prefer this., Matthew Fidler, 2014/07/02
- [elpa] 69/287: Install shortcut-layer appropriately for keymaps., Matthew Fidler, 2014/07/02
- [elpa] 73/287: use remove-duplicates instead, Matthew Fidler, 2014/07/02
- [elpa] 70/287: Fix most global-set-key after issues, Matthew Fidler, 2014/07/02
- [elpa] 65/287: Add more emulation alists. Less list manipulation, Matthew Fidler, 2014/07/02
- [elpa] 74/287: Fix <apps> e t bug with object interface., Matthew Fidler, 2014/07/02
- [elpa] 75/287: Only put in shortcut-hash if not removed from keymap., Matthew Fidler, 2014/07/02
- [elpa] 68/287: Make the caching more robust,
Matthew Fidler <=
- [elpa] 72/287: Fix copy objects to allow keymap versions., Matthew Fidler, 2014/07/02
- [elpa] 79/287: Fix final map to be a composed keymap that works with ergoemacs-rm-key, Matthew Fidler, 2014/07/02
- [elpa] 76/287: Only Issue 86 still persists., Matthew Fidler, 2014/07/02
- [elpa] 77/287: Ensure ergoemacs-global-override-rm-keys is a list of vectors, Matthew Fidler, 2014/07/02
- [elpa] 80/287: Reverse order to allow <apps> h z processing., Matthew Fidler, 2014/07/02
- [elpa] 82/287: Ignored keys shouldn't be in the shortcut hash, Matthew Fidler, 2014/07/02
- [elpa] 83/287: Allow ergoemacs-rm-key to remove a list, Matthew Fidler, 2014/07/02
- [elpa] 84/287: Break-out sending unread-command events, Matthew Fidler, 2014/07/02
- [elpa] 85/287: Keep track of shortcut key prefixes, Matthew Fidler, 2014/07/02
- [elpa] 81/287: Added version menu back, Matthew Fidler, 2014/07/02