tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-persist: Allow inhibiting of normalisation 

* lisp/org-persist.el (org-persist-register,
org-persist--normalize-container,
org-persist--inhibit-container-normalization): Since container
normalisation is applied frequently (via
`org-persist--normalize-container'), when registering many new
containers the cost can quickly add up.  To avoid redundant overhead,
after normalising the container initially in `org-persist-register' we
bind a new variable `org-persist--inhibit-container-normalization' to t
and adjust `org-persist--normalize-container' to do nothing when this
new variable is non-nil.
This commit is contained in:
TEC 2023-01-03 19:28:30 +08:00
parent a27cc761ff
commit 1931fc2131
Signed by: tec
SSH Key Fingerprint: SHA256:eobz41Mnm0/iYWBvWThftS0ElEs1ftBr6jamutnXc/A
1 changed files with 38 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lisp/org-persist.el
View File

@ -602,22 +602,27 @@ MISC, if non-nil will be appended to the collection. It must be a plist."
;;;; Reading container data. ;;;; Reading container data.
(defvar org-persist--inhibit-container-normalization nil
"Prevent `org-persist--normalize-container' from doing anything.")
(defun org-persist--normalize-container (container &optional inner) (defun org-persist--normalize-container (container &optional inner)
"Normalize CONTAINER representation into (type . settings). "Normalize CONTAINER representation into (type . settings).
When INNER is non-nil, do not try to match as list of containers." When INNER is non-nil, do not try to match as list of containers."
(pcase container (if org-persist--inhibit-container-normalization
((or `elisp `elisp-data `version `file `index `url) container
`(,container nil)) (pcase container
((or (pred keywordp) (pred stringp) `(quote . ,_)) ((or `elisp `elisp-data `version `file `index `url)
`(elisp-data ,container)) `(,container nil))
((pred symbolp) ((or (pred keywordp) (pred stringp) `(quote . ,_))
`(elisp ,container)) `(elisp-data ,container))
(`(,(or `elisp `elisp-data `version `file `index `url) . ,_) ((pred symbolp)
container) `(elisp ,container))
((and (pred listp) (guard (not inner))) (`(,(or `elisp `elisp-data `version `file `index `url) . ,_)
(mapcar (lambda (c) (org-persist--normalize-container c 'inner)) container)) container)
(_ (error "org-persist: Unknown container type: %S" container)))) ((and (pred listp) (guard (not inner)))
(mapcar (lambda (c) (org-persist--normalize-container c 'inner)) container))
(_ (error "org-persist: Unknown container type: %S" container)))))
(defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key) (defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key)
"Buffer hash cache.") "Buffer hash cache.")
@ -950,26 +955,27 @@ VALUE pairs.
When WRITE-IMMEDIATELY is non-nil, the return value will be the same When WRITE-IMMEDIATELY is non-nil, the return value will be the same
with `org-persist-write'." with `org-persist-write'."
(unless org-persist--index (org-persist--load-index)) (unless org-persist--index (org-persist--load-index))
(setq container (org-persist--normalize-container container)) (let ((container (org-persist--normalize-container container))
(when inherit (inherit (and inherit (org-persist--normalize-container inherit)))
(setq inherit (org-persist--normalize-container inherit)) (org-persist--inhibit-container-normalization t))
(let ((inherited-collection (org-persist--get-collection inherit associated)) (when inherit
new-collection) (let ((inherited-collection (org-persist--get-collection inherit associated))
(unless (member container (plist-get inherited-collection :container)) new-collection)
(setq new-collection (unless (member container (plist-get inherited-collection :container))
(plist-put (copy-sequence inherited-collection) :container (setq new-collection
(cons container (plist-get inherited-collection :container)))) (plist-put (copy-sequence inherited-collection) :container
(org-persist--remove-from-index inherited-collection) (cons container (plist-get inherited-collection :container))))
(org-persist--add-to-index new-collection)))) (org-persist--remove-from-index inherited-collection)
(let ((collection (org-persist--get-collection container associated misc))) (org-persist--add-to-index new-collection))))
(when (and expiry (not inherit)) (let ((collection (org-persist--get-collection container associated misc)))
(when expiry (plist-put collection :expiry expiry)))) (when (and expiry (not inherit))
(when (or (bufferp associated) (bufferp (plist-get associated :buffer))) (when expiry (plist-put collection :expiry expiry))))
(with-current-buffer (if (bufferp associated) (when (or (bufferp associated) (bufferp (plist-get associated :buffer)))
associated (with-current-buffer (if (bufferp associated)
(plist-get associated :buffer)) associated
(add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local))) (plist-get associated :buffer))
(when write-immediately (org-persist-write container associated))) (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local)))
(when write-immediately (org-persist-write container associated))))
(cl-defun org-persist-unregister (container &optional associated &key remove-related) (cl-defun org-persist-unregister (container &optional associated &key remove-related)
"Unregister CONTAINER in ASSOCIATED to be persistent. "Unregister CONTAINER in ASSOCIATED to be persistent.