diff options
Diffstat (limited to 'lisp/org/org-persist.el')
-rw-r--r-- | lisp/org/org-persist.el | 252 |
1 files changed, 130 insertions, 122 deletions
diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index 9645dea7d9e..6ccf357784e 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -222,8 +222,11 @@ function will be called with a single argument - collection." (defconst org-persist-index-file "index" "File name used to store the data index.") -(defvar org-persist-disable-when-emacs-Q t - "Disable persistence when Emacs is called with -Q command line arg.") +(defvar org-persist--disable-when-emacs-Q t + "Disable persistence when Emacs is called with -Q command line arg. +When non-nil, this sets `org-persist-directory' to temporary directory. + +This variable must be set before loading org-persist library.") (defvar org-persist-before-write-hook nil "Abnormal hook ran before saving data. @@ -662,12 +665,13 @@ COLLECTION is the plist holding data collection." (file-copy (org-file-name-concat org-persist-directory (format "%s-%s.%s" persist-file (md5 path) ext)))) - (unless (file-exists-p (file-name-directory file-copy)) - (make-directory (file-name-directory file-copy) t)) - (if (org--should-fetch-remote-resource-p path) - (url-copy-file path file-copy 'overwrite) - (error "The remote resource %S is considered unsafe, and will not be downloaded." - path)) + (unless (file-exists-p file-copy) + (unless (file-exists-p (file-name-directory file-copy)) + (make-directory (file-name-directory file-copy) t)) + (if (org--should-fetch-remote-resource-p path) + (url-copy-file path file-copy 'overwrite) + (error "The remote resource %S is considered unsafe, and will not be downloaded." + path))) (format "%s-%s.%s" persist-file (md5 path) ext))))) (defun org-persist-write:index (container _) @@ -771,43 +775,39 @@ ASSOCIATED can be a plist, a buffer, or a string. A buffer is treated as (:buffer ASSOCIATED). A string is treated as (:file ASSOCIATED). When LOAD? is non-nil, load the data instead of reading." + (unless org-persist--index (org-persist--load-index)) (setq associated (org-persist--normalize-associated associated)) (setq container (org-persist--normalize-container container)) - (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 - ;; "-Q" argument. - (not user-init-file)) - (let* ((collection (org-persist--find-index `(:container ,container :associated ,associated))) - (persist-file - (when collection - (org-file-name-concat - org-persist-directory - (plist-get collection :persist-file)))) - (data nil)) - (when (and collection - (file-exists-p persist-file) - (or (not (plist-get collection :expiry)) ; current session - (not (org-persist--gc-expired-p - (plist-get collection :expiry) collection))) - (or (not hash-must-match) - (and (plist-get associated :hash) - (equal (plist-get associated :hash) - (plist-get (plist-get collection :associated) :hash))))) - (unless (seq-find (lambda (v) - (run-hook-with-args-until-success 'org-persist-before-read-hook v associated)) - (plist-get collection :container)) - (setq data (or (gethash persist-file org-persist--write-cache) - (org-persist--read-elisp-file persist-file))) - (when data - (cl-loop for container in (plist-get collection :container) - with result = nil - do - (if load? - (push (org-persist-load:generic container (alist-get container data nil nil #'equal) collection) result) - (push (org-persist-read:generic container (alist-get container data nil nil #'equal) collection) result)) - (run-hook-with-args 'org-persist-after-read-hook container associated) - finally return (if (= 1 (length result)) (car result) result)))))))) + (let* ((collection (org-persist--find-index `(:container ,container :associated ,associated))) + (persist-file + (when collection + (org-file-name-concat + org-persist-directory + (plist-get collection :persist-file)))) + (data nil)) + (when (and collection + (file-exists-p persist-file) + (or (not (plist-get collection :expiry)) ; current session + (not (org-persist--gc-expired-p + (plist-get collection :expiry) collection))) + (or (not hash-must-match) + (and (plist-get associated :hash) + (equal (plist-get associated :hash) + (plist-get (plist-get collection :associated) :hash))))) + (unless (seq-find (lambda (v) + (run-hook-with-args-until-success 'org-persist-before-read-hook v associated)) + (plist-get collection :container)) + (setq data (or (gethash persist-file org-persist--write-cache) + (org-persist--read-elisp-file persist-file))) + (when data + (cl-loop for container in (plist-get collection :container) + with result = nil + do + (if load? + (push (org-persist-load:generic container (alist-get container data nil nil #'equal) collection) result) + (push (org-persist-read:generic container (alist-get container data nil nil #'equal) collection) result)) + (run-hook-with-args 'org-persist-after-read-hook container associated) + finally return (if (= 1 (length result)) (car result) result))))))) (defun org-persist-load (container &optional associated hash-must-match) "Load CONTAINER data for ASSOCIATED. @@ -843,62 +843,66 @@ The return value is nil when writing fails and the written value (as returned by `org-persist-read') on success. When IGNORE-RETURN is non-nil, just return t on success without calling `org-persist-read'." - (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 - ;; "-Q" argument. - (not user-init-file)) - (setq associated (org-persist--normalize-associated associated)) - ;; Update hash - (when (and (plist-get associated :file) - (plist-get associated :hash) - (get-file-buffer (plist-get associated :file))) - (setq associated (org-persist--normalize-associated (get-file-buffer (plist-get associated :file))))) - (let ((collection (org-persist--get-collection container associated))) - (setf collection (plist-put collection :associated associated)) - (unless (or - ;; Prevent data leakage from encrypted files. - ;; We do it in somewhat paranoid manner and do not - ;; allow anything related to encrypted files to be - ;; written. - (and (plist-get associated :file) - (string-match-p epa-file-name-regexp (plist-get associated :file))) - (seq-find (lambda (v) - (run-hook-with-args-until-success 'org-persist-before-write-hook v associated)) - (plist-get collection :container))) - (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) - (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) - (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) - (plist-get collection :container)))) - (puthash file data org-persist--write-cache) - (org-persist--write-elisp-file file data) - (or ignore-return (org-persist-read container associated)))))))) + (setq associated (org-persist--normalize-associated associated)) + ;; Update hash + (when (and (plist-get associated :file) + (plist-get associated :hash) + (get-file-buffer (plist-get associated :file))) + (setq associated (org-persist--normalize-associated (get-file-buffer (plist-get associated :file))))) + (let ((collection (org-persist--get-collection container associated))) + (setf collection (plist-put collection :associated associated)) + (unless (or + ;; Prevent data leakage from encrypted files. + ;; We do it in somewhat paranoid manner and do not + ;; allow anything related to encrypted files to be + ;; written. + (and (plist-get associated :file) + (string-match-p epa-file-name-regexp (plist-get associated :file))) + (seq-find (lambda (v) + (run-hook-with-args-until-success 'org-persist-before-write-hook v associated)) + (plist-get collection :container))) + (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) + (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) + (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) + (plist-get collection :container)))) + (puthash file data org-persist--write-cache) + (org-persist--write-elisp-file file data) + (or ignore-return (org-persist-read container associated))))))) (defun org-persist-write-all (&optional associated) "Save all the persistent data. When ASSOCIATED is non-nil, only save the matching data." (unless org-persist--index (org-persist--load-index)) (setq associated (org-persist--normalize-associated associated)) - (let (all-containers) - (dolist (collection org-persist--index) - (if associated - (when collection - (cl-pushnew (plist-get collection :container) all-containers :test #'equal)) - (condition-case err - (org-persist-write (plist-get collection :container) (plist-get collection :associated) t) - (error - (message "%s. Deleting bad index entry." err) - (org-persist--remove-from-index collection) - nil)))) - (dolist (container all-containers) - (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) - (when collection + (unless + (and (equal 1 (length org-persist--index)) + ;; The single collection only contains a single container + ;; in the container list. + (equal 1 (length (plist-get (car org-persist--index) :container))) + ;; The container is an `index' container. + (eq 'index (caar (plist-get (car org-persist--index) :container))) + ;; No `org-persist-directory' exists yet. + (not (file-exists-p org-persist-directory))) + (let (all-containers) + (dolist (collection org-persist--index) + (if associated + (when collection + (cl-pushnew (plist-get collection :container) all-containers :test #'equal)) (condition-case err - (org-persist-write container associated t) + (org-persist-write (plist-get collection :container) (plist-get collection :associated) t) (error (message "%s. Deleting bad index entry." err) (org-persist--remove-from-index collection) - nil))))))) + nil)))) + (dolist (container all-containers) + (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) + (when collection + (condition-case err + (org-persist-write container associated t) + (error + (message "%s. Deleting bad index entry." err) + (org-persist--remove-from-index collection) + nil)))))))) (defun org-persist-write-all-buffer () "Call `org-persist-write-all' in current buffer. @@ -931,45 +935,40 @@ Do nothing in an indirect buffer." (defun org-persist-gc () "Remove expired or unregistered containers. Also, remove containers associated with non-existing files." - (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 - ;; "-Q" argument. - (not user-init-file)) - (let (new-index (remote-files-num 0)) - (dolist (collection org-persist--index) - (let* ((file (plist-get (plist-get collection :associated) :file)) - (file-remote (when file (file-remote-p file))) - (persist-file (when (plist-get collection :persist-file) - (org-file-name-concat - org-persist-directory - (plist-get collection :persist-file)))) - (expired? (org-persist--gc-expired-p - (plist-get collection :expiry) collection))) - (when persist-file - (when file - (when file-remote (cl-incf remote-files-num)) - (unless (if (not file-remote) - (file-exists-p file) - (pcase org-persist-remote-files - ('t t) - ('check-existence - (file-exists-p file)) - ((pred numberp) - (<= org-persist-remote-files remote-files-num)) - (_ nil))) - (setq expired? t))) - (if expired? - (org-persist--gc-persist-file persist-file) - (push collection new-index))))) - (setq org-persist--index (nreverse new-index))))) + (let (new-index (remote-files-num 0)) + (dolist (collection org-persist--index) + (let* ((file (plist-get (plist-get collection :associated) :file)) + (file-remote (when file (file-remote-p file))) + (persist-file (when (plist-get collection :persist-file) + (org-file-name-concat + org-persist-directory + (plist-get collection :persist-file)))) + (expired? (org-persist--gc-expired-p + (plist-get collection :expiry) collection))) + (when persist-file + (when file + (when file-remote (cl-incf remote-files-num)) + (unless (if (not file-remote) + (file-exists-p file) + (pcase org-persist-remote-files + ('t t) + ('check-existence + (file-exists-p file)) + ((pred numberp) + (<= org-persist-remote-files remote-files-num)) + (_ nil))) + (setq expired? t))) + (if expired? + (org-persist--gc-persist-file persist-file) + (push collection new-index))))) + (setq org-persist--index (nreverse new-index)))) ;; Automatically write the data, but only when we have write access. (let ((dir (directory-file-name (file-name-as-directory org-persist-directory)))) (while (and (not (file-exists-p dir)) (not (equal dir (setq dir (directory-file-name - (file-name-directory dir))))))) + (file-name-directory dir))))))) (if (not (file-writable-p dir)) (message "Missing write access rights to org-persist-directory: %S" org-persist-directory) @@ -978,6 +977,15 @@ Also, remove containers associated with non-existing files." ;; So we are adding the hook after `org-persist-write-all'. (add-hook 'kill-emacs-hook #'org-persist-gc))) +;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set. +(if (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 + ;; "-Q" argument. + (not user-init-file)) + (setq org-persist-directory + (make-temp-file "org-persist-" 'dir))) + (add-hook 'after-init-hook #'org-persist-load-all) (provide 'org-persist) |