From 6a12fca24f1b89129424b8fc2902719f5e053832 Mon Sep 17 00:00:00 2001 From: TEC Date: Sat, 10 Dec 2022 23:53:44 +0800 Subject: [PATCH] org-persist: Merge index with index file content * lisp/org-persist.el (org-persist-write, org-persist-load, org-persist--index-age): Check if the index file has been externally updated since loading, and if so try to perform basic merging of the current index file contents and the loaded index before performing GC or overwriting the index file. --- lisp/org-persist.el | 53 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 46 insertions(+), 7 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index f215310a2..e9310d172 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -259,6 +259,9 @@ (defvar org-persist--index-hash nil "Hash table storing `org-persist--index'. Used for quick access. They keys are conses of (container . associated).") +(defvar org-persist--index-age nil + "The time at which the index was loaded, as given by `current-time'.") + (defvar org-persist--report-time 0.5 "Whether to report read/write time. @@ -589,8 +592,9 @@ (defalias 'org-persist-load:file #'org-persist-read:file) (defun org-persist-load:index (container index-file _) "Load `org-persist--index' from INDEX-FILE according to CONTAINER." (unless org-persist--index - (setq org-persist--index (org-persist-read:index container index-file nil)) - (setq org-persist--index-hash nil) + (setq org-persist--index (org-persist-read:index container index-file nil) + org-persist--index-hash nil + org-persist--index-age (current-time)) (if org-persist--index (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index) (setq org-persist--index nil) @@ -690,17 +694,49 @@ (defun org-persist-write:index (container _) (message "Missing write access rights to org-persist-directory: %S" org-persist-directory)))) (when (file-exists-p org-persist-directory) - (org-persist--write-elisp-file - (org-file-name-concat org-persist-directory org-persist-index-file) - org-persist--index - t t) - (org-file-name-concat org-persist-directory org-persist-index-file))) + (let ((index-file + (org-file-name-concat org-persist-directory org-persist-index-file))) + (org-persist--merge-index-with-disk) + (org-persist--write-elisp-file index-file org-persist--index t t) + (setq org-persist--index-age (current-time)) + index-file))) (defun org-persist--save-index () "Save `org-persist--index'." (org-persist-write:index `(index ,org-persist--storage-version) nil)) +(defun org-persist--merge-index-with-disk () + "Merge `org-persist--index' with the current index file on disk." + (let* ((index-file + (org-file-name-concat org-persist-directory org-persist-index-file)) + (disk-index + (and (file-exists-p index-file) + (org-file-newer-than-p index-file org-persist--index-age) + (org-persist-read:index `(index ,org-persist--storage-version) index-file nil))) + (combined-index + (org-persist--merge-index org-persist--index disk-index))) + (when disk-index + (setq org-persist--index combined-index + org-persist--index-age (current-time))))) + +(defun org-persist--merge-index (base other) + "Attempt to merge new index items in OTHER into BASE. +Items with different details are considered too difficult, and skipped." + (if other + (let ((new (cl-set-difference other base :test #'equal)) + (base-files (mapcar (lambda (s) (plist-get s :persist-file)) base)) + (combined (reverse base))) + (dolist (item (nreverse new)) + (unless (or (memq 'index (mapcar #'car (plist-get collection :container))) + (not (file-exists-p + (org-file-name-concat org-persist-directory + (plist-get item :persist-file)))) + (member (plist-get item :persist-file) base-files)) + (push item combined))) + (nreverse combined)) + base)) + ;;;; Public API (cl-defun org-persist-register (container &optional associated &rest misc @@ -951,6 +987,9 @@ (defun org-persist-associated-files:url (container collection) (defun org-persist-gc () "Remove expired or unregistered containers and orphaned files. Also, remove containers associated with non-existing files." + (if org-persist--index + (org-persist--merge-index-with-disk) + (org-persist--load-index)) (unless (and org-persist-disable-when-emacs-Q ;; FIXME: This is relying on undocumented fact that ;; Emacs sets `user-init-file' to nil when loaded with -- 2.38.1