|
|
@@ -24,6 +24,77 @@
|
|
|
;;
|
|
|
;; This file implements persistant data storage across Emacs sessions.
|
|
|
;; Both global and buffer-local data can be stored.
|
|
|
+;;
|
|
|
+;; Most common data type is variable data. However, other data types
|
|
|
+;; can also be stored.
|
|
|
+;;
|
|
|
+;; Persistent data is stored in individual files. Each of the files
|
|
|
+;; can contain a collection of related data, which is particularly
|
|
|
+;; useful when, say, several variables cross-reference each-other's
|
|
|
+;; data-cells and we want to preserve their circular structure.
|
|
|
+;;
|
|
|
+;; Each data collection can be associated with a local or remote file,
|
|
|
+;; its inode number, or contents hash. The persistent data collection
|
|
|
+;; can later be accessed using either file bufer, file, inode, or
|
|
|
+;; contents hash.
|
|
|
+;;
|
|
|
+;; The data collections can be versioned and removed upon expiry.
|
|
|
+;;
|
|
|
+;; In the code below I will use the following naming conventions:
|
|
|
+;; 1. Container :: a type of data to be stored
|
|
|
+;; Containers can store elisp variables, files, and version
|
|
|
+;; numbers. Each container can be customized with container
|
|
|
+;; options. For example, "elisp" container is customized with
|
|
|
+;; variable symbol. ("elisp" variable) is a container storing
|
|
|
+;; Lisp variable value. Similarly, ("version" "2.0") container
|
|
|
+;; will store version number.
|
|
|
+;; 2. Associated :: an object the container is associated with. The
|
|
|
+;; object can be a buffer, file, inode number, file contents hash,
|
|
|
+;; a generic key, or multiple of them. Associated can also be nil.
|
|
|
+;; 3. Data collection :: a list of containers linked to an associated
|
|
|
+;; object/objects. Each data collection can also have auxiliary
|
|
|
+;; records. Their only purpose is readability of the collection
|
|
|
+;; index.
|
|
|
+;; 4. Index file :: a file listing all the stored data collections.
|
|
|
+;; 5. Persist file :: a file holding data values or references to
|
|
|
+;; actual data values for a single data collection. This file
|
|
|
+;; contains an alist associating each data container in data
|
|
|
+;; collection with its value or a reference to the actual value.
|
|
|
+;;
|
|
|
+;; All the persistent data is stored in `org-persist-directory'. The data
|
|
|
+;; collections are listed in `org-persist-index-file' and the actual data is
|
|
|
+;; stored in UID-style subfolders.
|
|
|
+;;
|
|
|
+;; The `org-persist-index-file' stores the value of `org-persist--index'.
|
|
|
+;;
|
|
|
+;; Each collection is represented as a plist containing the following
|
|
|
+;; properties:
|
|
|
+;; - `:container' : list of data continers to be stored in single
|
|
|
+;; file;
|
|
|
+;; - `:persist-file': data file name;
|
|
|
+;; - `:associated' : list of associated objects;
|
|
|
+;; - `:last-access' : last date when the container has been read;
|
|
|
+;; - `:expiry' : list of expiry conditions.
|
|
|
+;; - all other keywords are ignored
|
|
|
+;;
|
|
|
+;; The available types of data containers are:
|
|
|
+;; 1. ("elisp" variable-symbol) or just variable-symbol :: Storing
|
|
|
+;; elisp variable data.
|
|
|
+;; 2. ("file") :: Store a copy of the associated file preserving the
|
|
|
+;; extension.
|
|
|
+;; 3. ("version" "version number") :: Version the data collection.
|
|
|
+;; If the stored collection has different version than "version
|
|
|
+;; number", disregard it.
|
|
|
+;; 4. ("url") :: Store a downloaded copy of URL object.
|
|
|
+;;
|
|
|
+;; The data collections can expire, in which case they will be removed
|
|
|
+;; from the persistent storage at the end of Emacs session. The
|
|
|
+;; expiry condition can be set when saving/registering data
|
|
|
+;; containers. The expirty condition can be `never' - data will never
|
|
|
+;; expire; `nil' - data will expire at the end of current Emacs session;
|
|
|
+;; a number - data will expire after the number days from last access;
|
|
|
+;; a function - data will expire if the function, called with a single
|
|
|
+;; argument - collection, returns non-nil.
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
@@ -31,10 +102,8 @@
|
|
|
(require 'org-id)
|
|
|
(require 'xdg nil t)
|
|
|
|
|
|
-(declare-function org-back-to-heading "org" (&optional invisible-ok))
|
|
|
-(declare-function org-next-visible-heading "org" (arg))
|
|
|
-(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
|
|
|
-
|
|
|
+(defconst org-persist--storage-version "2.0"
|
|
|
+ "Persistent storage layout version.")
|
|
|
|
|
|
(defgroup org-persist nil
|
|
|
"Persistent cache for Org mode."
|
|
|
@@ -42,51 +111,74 @@
|
|
|
:group 'org)
|
|
|
|
|
|
(defcustom org-persist-directory (expand-file-name
|
|
|
- (org-file-name-concat
|
|
|
- (let ((cache-dir (when (fboundp 'xdg-cache-home)
|
|
|
- (xdg-cache-home))))
|
|
|
- (if (or (seq-empty-p cache-dir)
|
|
|
- (not (file-exists-p cache-dir))
|
|
|
- (file-exists-p (org-file-name-concat
|
|
|
- user-emacs-directory
|
|
|
- "org-persist")))
|
|
|
- user-emacs-directory
|
|
|
- cache-dir))
|
|
|
- "org-persist/"))
|
|
|
+ (org-file-name-concat
|
|
|
+ (let ((cache-dir (when (fboundp 'xdg-cache-home)
|
|
|
+ (xdg-cache-home))))
|
|
|
+ (if (or (seq-empty-p cache-dir)
|
|
|
+ (not (file-exists-p cache-dir))
|
|
|
+ (file-exists-p (org-file-name-concat
|
|
|
+ user-emacs-directory
|
|
|
+ "org-persist")))
|
|
|
+ user-emacs-directory
|
|
|
+ cache-dir))
|
|
|
+ "org-persist/"))
|
|
|
"Directory where the data is stored."
|
|
|
:group 'org-persist
|
|
|
:type 'directory)
|
|
|
|
|
|
-(defvar org-persist-index-file "index"
|
|
|
+(defcustom org-persist-remote-files 100
|
|
|
+ "Whether to keep persistent data for remote files.
|
|
|
+
|
|
|
+When this variable is nil, never save persitent data associated with
|
|
|
+remote files. When `t', always keep the data. When
|
|
|
+`check-existence', contact remote server containing the file and only
|
|
|
+keep the data when the file exists on the server. When a number, keep
|
|
|
+up to that number persistent values for remote files.
|
|
|
+
|
|
|
+Note that the last option `check-existence' may cause Emacs to show
|
|
|
+password prompts to log in."
|
|
|
+ :group 'org-persist
|
|
|
+ :type '(choice (const :tag "Never" nil)
|
|
|
+ (const :tag "Always" t)
|
|
|
+ (number :tag "Keep not more than X files")
|
|
|
+ (const :tag "Check if exist on remote" 'check-existence)))
|
|
|
+
|
|
|
+(defconst org-persist-index-file "index"
|
|
|
"File name used to store the data index.")
|
|
|
|
|
|
(defvar org-persist-before-write-hook nil
|
|
|
- "Abnormal hook ran before saving data for a single variable in a buffer.
|
|
|
+ "Abnormal hook ran before saving data.
|
|
|
The hook must accept the same arguments as `org-persist-write'.
|
|
|
The hooks will be evaluated until a hook returns non-nil.
|
|
|
If any of the hooks return non-nil, do not save the data.")
|
|
|
|
|
|
(defvar org-persist-before-read-hook nil
|
|
|
- "Abnormal hook ran before reading data for a single variable in a buffer.
|
|
|
+ "Abnormal hook ran before reading data.
|
|
|
The hook must accept the same arguments as `org-persist-read'.
|
|
|
The hooks will be evaluated until a hook returns non-nil.
|
|
|
If any of the hooks return non-nil, do not read the data.")
|
|
|
|
|
|
(defvar org-persist-after-read-hook nil
|
|
|
- "Abnormal hook ran after reading data for a single variable in a buffer.
|
|
|
+ "Abnormal hook ran after reading data.
|
|
|
The hook must accept the same arguments as `org-persist-read'.")
|
|
|
|
|
|
(defvar org-persist--index nil
|
|
|
"Global index.
|
|
|
|
|
|
The index is a list of plists. Each plist contains information about
|
|
|
-a data variable. Each plist contains the following properties:
|
|
|
+persistent data storage. Each plist contains the following
|
|
|
+properties:
|
|
|
|
|
|
- - `:variable' list of variables to be stored in single file
|
|
|
+ - `:container' : list of data continers to be stored in single file
|
|
|
- `:persist-file': data file name
|
|
|
- - `:path': buffer file path, if any
|
|
|
- - `:inode': buffer file inode, if any
|
|
|
- - `:hash': buffer hash, if any")
|
|
|
+ - `:associated' : list of associated objects
|
|
|
+ - `:last-access' : last date when the container has been read
|
|
|
+ - `:expiry' : list of expiry conditions
|
|
|
+ - all other keywords are ignored.")
|
|
|
+
|
|
|
+(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--report-time 0.5
|
|
|
"Whether to report read/write time.
|
|
|
@@ -98,245 +190,577 @@ message is displayed.
|
|
|
When the value is a non-nil non-number, always display the message.
|
|
|
When the value is nil, never diplay the message.")
|
|
|
|
|
|
-(defun org-persist--get-index (var &optional buffer)
|
|
|
- "Return plist used to store VAR in BUFFER.
|
|
|
-When BUFFER is nil, return plist for global VAR."
|
|
|
- (org-persist--read-index)
|
|
|
- (let* ((buffer-file (when buffer (buffer-file-name (or (buffer-base-buffer buffer)
|
|
|
- buffer))))
|
|
|
- (inode (when buffer-file
|
|
|
- (and (fboundp 'file-attribute-inode-number)
|
|
|
- (file-attribute-inode-number (file-attributes buffer-file)))))
|
|
|
- (buffer-hash (when buffer (secure-hash 'md5 buffer))))
|
|
|
- (let ((result (seq-find (lambda (plist)
|
|
|
- (and (or (memq var (plist-get plist :variable))
|
|
|
- (eq var (plist-get plist :variable)))
|
|
|
- (or (and inode (equal inode (plist-get plist :inode)))
|
|
|
- (and buffer-file (equal buffer-file (plist-get plist :path)))
|
|
|
- (and buffer-hash (equal buffer-hash (plist-get plist :hash))))))
|
|
|
- org-persist--index)))
|
|
|
- (when result
|
|
|
- (unless (equal buffer-file (plist-get result :path))
|
|
|
- (setf result (plist-put result :path buffer-file))))
|
|
|
- (unless result
|
|
|
- (push (list :variable (if (listp var) var (list var))
|
|
|
- :persist-file (replace-regexp-in-string "^.." "\\&/" (org-id-uuid))
|
|
|
- :path buffer-file
|
|
|
- :inode inode
|
|
|
- :hash buffer-hash)
|
|
|
- org-persist--index)
|
|
|
- (setf result (car org-persist--index)))
|
|
|
- result)))
|
|
|
-
|
|
|
-(defun org-persist--read-index ()
|
|
|
- "Read `org-persist--index'"
|
|
|
- (unless org-persist--index
|
|
|
- (when (file-exists-p (org-file-name-concat org-persist-directory org-persist-index-file))
|
|
|
- (with-temp-buffer
|
|
|
- (insert-file-contents (org-file-name-concat org-persist-directory org-persist-index-file))
|
|
|
- (setq org-persist--index
|
|
|
- (condition-case err
|
|
|
- (read (current-buffer))
|
|
|
- ;; Recover gracefully if index file is corrupted.
|
|
|
- (error
|
|
|
- (warn "Emacs reader failed to read data for `org-persist--index' from %S. The error was: %S"
|
|
|
- (org-file-name-concat org-persist-directory org-persist-index-file)
|
|
|
- (error-message-string err))
|
|
|
- nil)))))))
|
|
|
-
|
|
|
-(cl-defun org-persist-register (var &optional buffer &key inherit)
|
|
|
- "Register VAR in BUFFER to be persistent.
|
|
|
-Optional key INHERIT make VAR dependent on another variable. Such
|
|
|
-dependency means that data shared between variables will be preserved
|
|
|
-(see elisp#Circular Objects)."
|
|
|
- (unless org-persist--index (org-persist--read-index))
|
|
|
- (when inherit
|
|
|
- (let ((inherited-index (org-persist--get-index inherit buffer)))
|
|
|
- (unless (memq var (plist-get inherited-index :variable))
|
|
|
- (setq inherited-index
|
|
|
- (plist-put inherited-index :variable
|
|
|
- (cons var (plist-get inherited-index :variable)))))))
|
|
|
- (org-persist--get-index var buffer)
|
|
|
- (when buffer
|
|
|
- (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local)))
|
|
|
-
|
|
|
-(defun org-persist-unregister (var &optional buffer)
|
|
|
- "Unregister VAR in BUFFER to be persistent.
|
|
|
-When BUFFER is `all', unregister VAR in all buffers."
|
|
|
- (unless org-persist--index (org-persist--read-index))
|
|
|
- (setq org-persist--index
|
|
|
- (seq-remove
|
|
|
- (lambda (plist)
|
|
|
- (when (and (memq var (plist-get plist :variable))
|
|
|
- (or (eq buffer 'all)
|
|
|
- (string= (buffer-file-name
|
|
|
- (or (buffer-base-buffer buffer)
|
|
|
- buffer))
|
|
|
- (or (plist-get plist :path) ""))))
|
|
|
- (if (> (length (plist-get plist :variable)) 1)
|
|
|
- (progn
|
|
|
- (setq plist
|
|
|
- (plist-put plist :variable
|
|
|
- (delq var (plist-get plist :variable))))
|
|
|
- ;; Do not remove the index though.
|
|
|
- nil)
|
|
|
- (let ((persist-file (org-file-name-concat org-persist-directory (plist-get plist :persist-file))))
|
|
|
- (delete-file persist-file)
|
|
|
- (when (org-directory-empty-p (file-name-directory persist-file))
|
|
|
- (delete-directory (file-name-directory persist-file))))
|
|
|
- 'delete-from-index)))
|
|
|
- org-persist--index))
|
|
|
- (org-persist-gc))
|
|
|
-
|
|
|
-(defun org-persist-write (var &optional buffer)
|
|
|
- "Save buffer-local data in BUFFER for VAR."
|
|
|
- (unless (and buffer (not (get-buffer buffer)))
|
|
|
- (unless (listp var) (setq var (list var)))
|
|
|
- (with-current-buffer (or buffer (current-buffer))
|
|
|
- (let ((index (org-persist--get-index var buffer))
|
|
|
- (start-time (float-time)))
|
|
|
- (setf index (plist-put index :hash (when buffer (secure-hash 'md5 buffer))))
|
|
|
- (let ((print-circle t)
|
|
|
- print-level
|
|
|
- print-length
|
|
|
- print-quoted
|
|
|
- (print-escape-control-characters t)
|
|
|
- (print-escape-nonascii t)
|
|
|
- (print-continuous-numbering t)
|
|
|
- print-number-table)
|
|
|
- (unless (seq-find (lambda (v)
|
|
|
- (run-hook-with-args-until-success 'org-persist-before-write-hook v buffer))
|
|
|
- (plist-get index :variable))
|
|
|
- (unless (file-exists-p org-persist-directory)
|
|
|
- (make-directory org-persist-directory))
|
|
|
- (unless (file-exists-p org-persist-directory)
|
|
|
- (warn "Failed to create org-persist storage in %s."
|
|
|
- org-persist-directory)
|
|
|
- (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)))))))
|
|
|
- (unless (file-writable-p dir)
|
|
|
- (message "Missing write access rights to org-persist-directory: %S"
|
|
|
- org-persist-directory))))
|
|
|
- (when (file-exists-p org-persist-directory)
|
|
|
- (with-temp-file (org-file-name-concat org-persist-directory org-persist-index-file)
|
|
|
- (prin1 org-persist--index (current-buffer)))
|
|
|
- (let ((file (org-file-name-concat org-persist-directory (plist-get index :persist-file)))
|
|
|
- (data (mapcar (lambda (s) (cons s (symbol-value s)))
|
|
|
- (plist-get index :variable))))
|
|
|
- (unless (file-exists-p (file-name-directory file))
|
|
|
- (make-directory (file-name-directory file) t))
|
|
|
- (with-temp-file file
|
|
|
- (prin1 data (current-buffer)))
|
|
|
- (let ((duration (- (float-time) start-time)))
|
|
|
- (when (or (and org-persist--report-time
|
|
|
- (numberp org-persist--report-time)
|
|
|
- (>= duration org-persist--report-time))
|
|
|
- (and org-persist--report-time
|
|
|
- (not (numberp org-persist--report-time))))
|
|
|
- (if buffer
|
|
|
- (message "org-persist: Writing %S from %S took %.2f sec"
|
|
|
- var buffer duration)
|
|
|
- (message "org-persist: Writing %S took %.2f sec"
|
|
|
- var duration))))))))))))
|
|
|
-
|
|
|
-(defun org-persist-write-all (&optional buffer)
|
|
|
- "Save all the persistent data."
|
|
|
- (unless (and buffer (not (buffer-file-name buffer)))
|
|
|
- (dolist (index org-persist--index)
|
|
|
- (when (or (and (not (plist-get index :path))
|
|
|
- (not buffer))
|
|
|
- (and (plist-get index :path)
|
|
|
- (get-file-buffer (plist-get index :path))
|
|
|
- (equal (buffer-file-name
|
|
|
- (or buffer
|
|
|
- (get-file-buffer (plist-get index :path))))
|
|
|
- (plist-get index :path))))
|
|
|
- (org-persist-write (plist-get index :variable)
|
|
|
- (when (plist-get index :path)
|
|
|
- (get-file-buffer (plist-get index :path))))))))
|
|
|
-
|
|
|
-(defun org-persist-write-all-buffer ()
|
|
|
- "Call `org-persist-write-all' in current buffer."
|
|
|
- (org-persist-write-all (current-buffer)))
|
|
|
-
|
|
|
-(defun org-persist-read (var &optional buffer)
|
|
|
- "Restore VAR data in BUFFER."
|
|
|
- (let* ((index (org-persist--get-index var buffer))
|
|
|
- (persist-file (org-file-name-concat org-persist-directory (plist-get index :persist-file)))
|
|
|
- (data nil)
|
|
|
- (start-time (float-time)))
|
|
|
- (when (and index
|
|
|
- (file-exists-p persist-file)
|
|
|
- (or (not buffer)
|
|
|
- (equal (secure-hash 'md5 buffer) (plist-get index :hash))))
|
|
|
- (unless (seq-find (lambda (v)
|
|
|
- (run-hook-with-args-until-success 'org-persist-before-read-hook v buffer))
|
|
|
- (plist-get index :variable))
|
|
|
- (with-temp-buffer
|
|
|
- (let ((coding-system-for-read 'utf-8)
|
|
|
- (read-circle t))
|
|
|
- (insert-file-contents persist-file))
|
|
|
+;;;; Common functions
|
|
|
+
|
|
|
+(defun org-persist--display-time (duration format &rest args)
|
|
|
+ "Report DURATION according to FORMAT + ARGS message.
|
|
|
+FORMAT and ARGS are passed to `message'."
|
|
|
+ (when (or (and org-persist--report-time
|
|
|
+ (numberp org-persist--report-time)
|
|
|
+ (>= duration org-persist--report-time))
|
|
|
+ (and org-persist--report-time
|
|
|
+ (not (numberp org-persist--report-time))))
|
|
|
+ (apply #'message
|
|
|
+ (format "org-persist: %s took %%.2f sec" format)
|
|
|
+ (append args (list duration)))))
|
|
|
+
|
|
|
+(defun org-persist--read-elisp-file (&optional buffer-or-file)
|
|
|
+ "Read elisp data from BUFFER-OR-FILE or current buffer."
|
|
|
+ (unless buffer-or-file (setq buffer-or-file (current-buffer)))
|
|
|
+ (with-temp-buffer
|
|
|
+ (if (bufferp buffer-or-file)
|
|
|
+ (set-buffer buffer-or-file)
|
|
|
+ (insert-file-contents buffer-or-file))
|
|
|
+ (condition-case err
|
|
|
+ (let ((coding-system-for-read 'utf-8)
|
|
|
+ (read-circle t)
|
|
|
+ (start-time (float-time)))
|
|
|
;; FIXME: Reading sometimes fails to read circular objects.
|
|
|
;; I suspect that it happens when we have object reference
|
|
|
;; #N# read before object definition #N=. If it is really
|
|
|
;; so, it should be Emacs bug - either in `read' or in
|
|
|
;; `prin1'. Meanwhile, just fail silently when `read'
|
|
|
;; fails to parse the saved cache object.
|
|
|
- (condition-case err
|
|
|
- (setq data (read (current-buffer)))
|
|
|
- (error
|
|
|
- ;; Do not report the known error to user.
|
|
|
- (unless (string-match-p "Invalid read syntax" (error-message-string err))
|
|
|
- (warn "Emacs reader failed to read data for %S:%S. The error was: %S"
|
|
|
- (or buffer "global") var (error-message-string err)))
|
|
|
- (setq data nil))))
|
|
|
- (with-current-buffer (or buffer (current-buffer))
|
|
|
- (cl-loop for var1 in (plist-get index :variable)
|
|
|
- do
|
|
|
- (when (alist-get var1 data)
|
|
|
- (setf (symbol-value var1) (alist-get var1 data)))
|
|
|
- (run-hook-with-args 'org-persist-after-read-hook var1 buffer)))
|
|
|
- (let ((duration (- (float-time) start-time)))
|
|
|
- (when (or (and org-persist--report-time
|
|
|
- (numberp org-persist--report-time)
|
|
|
- (>= duration org-persist--report-time))
|
|
|
- (and org-persist--report-time
|
|
|
- (not (numberp org-persist--report-time))))
|
|
|
- (if buffer
|
|
|
- (message "org-persist: Reading %S from %S took %.2f sec"
|
|
|
- var buffer duration)
|
|
|
- (message "org-persist: Reading %S took %.2f sec"
|
|
|
- var duration))))))))
|
|
|
-
|
|
|
-(defun org-persist-read-all (&optional buffer)
|
|
|
- "Restore all the persistent data in BUFFER."
|
|
|
- (unless org-persist--index (org-persist--read-index))
|
|
|
- (dolist (index org-persist--index)
|
|
|
- (org-persist-read (plist-get index :variable) buffer)))
|
|
|
-
|
|
|
-(defun org-persist-read-all-buffer ()
|
|
|
- "Call `org-persist-read-all' in current buffer."
|
|
|
- (org-persist-read-all (current-buffer)))
|
|
|
+ (prog1
|
|
|
+ (read (current-buffer))
|
|
|
+ (org-persist--display-time
|
|
|
+ (- (float-time) start-time)
|
|
|
+ "Reading from %S" buffer-or-file)))
|
|
|
+ ;; Recover gracefully if index file is corrupted.
|
|
|
+ (error
|
|
|
+ ;; Remove problematic file.
|
|
|
+ (unless (bufferp buffer-or-file) (delete-file buffer-or-file))
|
|
|
+ ;; Do not report the known error to user.
|
|
|
+ (unless (string-match-p "Invalid read syntax" (error-message-string err))
|
|
|
+ (warn "Emacs reader failed to read data in %S. The error was: %S"
|
|
|
+ buffer-or-file (error-message-string err)))
|
|
|
+ nil))))
|
|
|
+
|
|
|
+(defun org-persist--write-elisp-file (file data &optional no-circular pp)
|
|
|
+ "Write elisp DATA to FILE."
|
|
|
+ (let ((print-circle (not no-circular))
|
|
|
+ print-level
|
|
|
+ print-length
|
|
|
+ print-quoted
|
|
|
+ (print-escape-control-characters t)
|
|
|
+ (print-escape-nonascii t)
|
|
|
+ (print-continuous-numbering t)
|
|
|
+ print-number-table
|
|
|
+ (start-time (float-time)))
|
|
|
+ (unless (file-exists-p (file-name-directory file))
|
|
|
+ (make-directory (file-name-directory file) t))
|
|
|
+ (with-temp-file file
|
|
|
+ (if pp
|
|
|
+ (pp data (current-buffer))
|
|
|
+ (prin1 data (current-buffer))))
|
|
|
+ (org-persist--display-time
|
|
|
+ (- (float-time) start-time)
|
|
|
+ "Writing to %S" file)))
|
|
|
+
|
|
|
+;;;; Working with index
|
|
|
+
|
|
|
+(defmacro org-persist-collection-let (collection &rest body)
|
|
|
+ "Bind container and associated from COLLECTION and execute BODY."
|
|
|
+ (declare (debug (form body)) (indent 1))
|
|
|
+ `(let* ((container (plist-get ,collection :container))
|
|
|
+ (associated (plist-get ,collection :associated))
|
|
|
+ (path (plist-get associated :file))
|
|
|
+ (inode (plist-get associated :inode))
|
|
|
+ (hash (plist-get associated :hash))
|
|
|
+ (key (plist-get associated :key)))
|
|
|
+ ,@body))
|
|
|
+
|
|
|
+(defun org-persist--find-index (collection)
|
|
|
+ "Find COLLECTION in `org-persist--index'."
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (and org-persist--index-hash
|
|
|
+ (catch :found
|
|
|
+ (dolist (cont (cons container container))
|
|
|
+ (let (r)
|
|
|
+ (setq r (or (gethash (cons cont associated) org-persist--index-hash)
|
|
|
+ (and path (gethash (cons cont (list :file path)) org-persist--index-hash))
|
|
|
+ (and inode (gethash (cons cont (list :inode inode)) org-persist--index-hash))
|
|
|
+ (and hash (gethash (cons cont (list :hash hash)) org-persist--index-hash))
|
|
|
+ (and key (gethash (cons cont (list :key key)) org-persist--index-hash))))
|
|
|
+ (when r (throw :found r))))))))
|
|
|
+
|
|
|
+(defun org-persist--add-to-index (collection &optional hash-only)
|
|
|
+ "Add or update COLLECTION in `org-persist--index'.
|
|
|
+When optional HASH-ONLY is non-nil, only modify the hash table.
|
|
|
+Return PLIST."
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (let ((existing (org-persist--find-index collection)))
|
|
|
+ (if existing
|
|
|
+ (progn
|
|
|
+ (plist-put existing :container container)
|
|
|
+ (plist-put (plist-get existing :associated) :file path)
|
|
|
+ (plist-put (plist-get existing :associated) :inode inode)
|
|
|
+ (plist-put (plist-get existing :associated) :hash hash)
|
|
|
+ (plist-put (plist-get existing :associated) :key key)
|
|
|
+ existing)
|
|
|
+ (unless hash-only (push collection org-persist--index))
|
|
|
+ (unless org-persist--index-hash (setq org-persist--index-hash (make-hash-table :test 'equal)))
|
|
|
+ (dolist (cont (cons container container))
|
|
|
+ (puthash (cons cont associated) collection org-persist--index-hash)
|
|
|
+ (when path (puthash (cons cont (list :file path)) collection org-persist--index-hash))
|
|
|
+ (when inode (puthash (cons cont (list :inode inode)) collection org-persist--index-hash))
|
|
|
+ (when hash (puthash (cons cont (list :hash inode)) collection org-persist--index-hash))
|
|
|
+ (when key (puthash (cons cont (list :key inode)) collection org-persist--index-hash)))
|
|
|
+ collection))))
|
|
|
+
|
|
|
+(defun org-persist--remove-from-index (collection)
|
|
|
+ "Remove COLLECTION from `org-persist--index'."
|
|
|
+ (let ((existing (org-persist--find-index collection)))
|
|
|
+ (when existing
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (dolist (cont (cons container container))
|
|
|
+ (remhash (cons cont associated) org-persist--index-hash)
|
|
|
+ (when path (remhash (cons cont (list :file path)) org-persist--index-hash))
|
|
|
+ (when inode (remhash (cons cont (list :inode inode)) org-persist--index-hash))
|
|
|
+ (when hash (remhash (cons cont (list :hash hash)) org-persist--index-hash))
|
|
|
+ (when key (remhash (cons cont (list :key key)) org-persist--index-hash))))
|
|
|
+ (setq org-persist--index (delq existing org-persist--index)))))
|
|
|
+
|
|
|
+(defun org-persist--get-collection (container &optional associated &rest misc)
|
|
|
+ "Return or create collection used to store CONTAINER for ASSOCIATED.
|
|
|
+When ASSOCIATED is nil, it is a global CONTAINER.
|
|
|
+ASSOCIATED can also be a (:buffer buffer) or buffer, (:file file-path)
|
|
|
+or file-path, (:inode inode), (:hash hash), or or (:key key)."
|
|
|
+ (unless (and (listp container) (listp (car container)))
|
|
|
+ (setq container (list container)))
|
|
|
+ (setq associated (org-persist--normalize-associated associated))
|
|
|
+ (unless (equal misc '(nil))
|
|
|
+ (setq associated (append associated misc)))
|
|
|
+ (or (org-persist--find-index
|
|
|
+ `( :container ,(org-persist--normalize-container container)
|
|
|
+ :associated ,associated))
|
|
|
+ (org-persist--add-to-index
|
|
|
+ (list :container (org-persist--normalize-container container)
|
|
|
+ :persist-file
|
|
|
+ (replace-regexp-in-string "^.." "\\&/" (org-id-uuid))
|
|
|
+ :associated associated))))
|
|
|
+
|
|
|
+;;;; Reading container data.
|
|
|
+
|
|
|
+(defun org-persist--normalize-container (container)
|
|
|
+ "Normalize CONTAINER representation into (type . settings)."
|
|
|
+ (if (and (listp container) (listp (car container)))
|
|
|
+ (mapcar #'org-persist--normalize-container container)
|
|
|
+ (pcase container
|
|
|
+ ((pred symbolp)
|
|
|
+ (list "elisp" container))
|
|
|
+ ((pred stringp)
|
|
|
+ (list container nil))
|
|
|
+ (`(,(or "elisp" "version" "file" "index" "url") . ,_)
|
|
|
+ container)
|
|
|
+ (_ (error "org-persist: Unknown container type: %S" container)))))
|
|
|
+
|
|
|
+(defun org-persist--normalize-associated (associated)
|
|
|
+ "Normalize ASSOCIATED representation into (:type value)."
|
|
|
+ (pcase associated
|
|
|
+ ((or (pred stringp) `(:file ,associated2))
|
|
|
+ (when associated2 (setq associated associated2))
|
|
|
+ (let* ((rtn `(:file ,associated))
|
|
|
+ (inode (and (fboundp 'file-attribute-inode-number)
|
|
|
+ (file-attribute-inode-number
|
|
|
+ (file-attributes associated)))))
|
|
|
+ (when inode (plist-put rtn :inode inode))
|
|
|
+ rtn))
|
|
|
+ ((or (pred bufferp) `(:buffer ,associated2))
|
|
|
+ (when associated2 (setq associated associated2))
|
|
|
+ (let* ((file (buffer-file-name
|
|
|
+ (or (buffer-base-buffer associated)
|
|
|
+ associated)))
|
|
|
+ (inode (when (and file
|
|
|
+ (fboundp 'file-attribute-inode-number))
|
|
|
+ (file-attribute-inode-number
|
|
|
+ (file-attributes file))))
|
|
|
+ (hash (secure-hash 'md5 associated)))
|
|
|
+ (let ((rtn `(:hash ,hash)))
|
|
|
+ (when file (setq rtn (plist-put rtn :file file)))
|
|
|
+ (when inode (setq rtn (plist-put rtn :inode inode)))
|
|
|
+ rtn)))
|
|
|
+ ((pred listp)
|
|
|
+ associated)
|
|
|
+ (_ (error "Unknown associated object %S" associated))))
|
|
|
+
|
|
|
+(defmacro org-persist-read:generic (container reference-data collection)
|
|
|
+ "Read and return the data stored in CONTAINER.
|
|
|
+REFERENCE-DATA is associated with CONTAINER in the persist file.
|
|
|
+COLLECTION is the plist holding data collectin."
|
|
|
+ `(let* ((c (org-persist--normalize-container ,container))
|
|
|
+ (read-func-symbol (intern (format "org-persist-read:%s" (car c)))))
|
|
|
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
|
|
|
+ (unless (fboundp read-func-symbol)
|
|
|
+ (error "org-persist: Read function %s not defined"
|
|
|
+ read-func-symbol))
|
|
|
+ (funcall read-func-symbol c ,reference-data ,collection)))
|
|
|
+
|
|
|
+(defun org-persist-read:elisp (_ lisp-value _)
|
|
|
+ "Read elisp container and return the stored data."
|
|
|
+ lisp-value)
|
|
|
+
|
|
|
+(defun org-persist-read:version (container _ _)
|
|
|
+ "Read version container."
|
|
|
+ (cadr container))
|
|
|
+
|
|
|
+(defun org-persist-read:file (_ path _)
|
|
|
+ "Read file container."
|
|
|
+ (when (and path (file-exists-p (concat org-persist-directory path)))
|
|
|
+ (concat org-persist-directory path)))
|
|
|
+
|
|
|
+(defun org-persist-read:url (_ path _)
|
|
|
+ "Read file container."
|
|
|
+ (when (and path (file-exists-p (concat org-persist-directory path)))
|
|
|
+ (concat org-persist-directory path)))
|
|
|
+
|
|
|
+(defun org-persist-read:index (cont index-file _)
|
|
|
+ "Read index container."
|
|
|
+ (when (file-exists-p index-file)
|
|
|
+ (let ((index (org-persist--read-elisp-file index-file)))
|
|
|
+ (when index
|
|
|
+ (catch :found
|
|
|
+ (dolist (collection index)
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (when (and (not associated)
|
|
|
+ (pcase container
|
|
|
+ (`(("index" ,version))
|
|
|
+ (equal version (cadr cont)))
|
|
|
+ (_ nil)))
|
|
|
+ (throw :found index)))))))))
|
|
|
+
|
|
|
+;;;; Applying container data for side effects.
|
|
|
+
|
|
|
+(defmacro org-persist-load:generic (container reference-data collection)
|
|
|
+ "Load the data stored in CONTAINER for side effects.
|
|
|
+REFERENCE-DATA is associated with CONTAINER in the persist file.
|
|
|
+COLLECTION is the plist holding data collectin."
|
|
|
+ `(let* ((container (org-persist--normalize-container ,container))
|
|
|
+ (load-func-symbol (intern (format "org-persist-load:%s" (car container)))))
|
|
|
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
|
|
|
+ (unless (fboundp load-func-symbol)
|
|
|
+ (error "org-persist: Load function %s not defined"
|
|
|
+ load-func-symbol))
|
|
|
+ (funcall load-func-symbol container ,reference-data ,collection)))
|
|
|
+
|
|
|
+(defun org-persist-load:elisp (container lisp-value associated)
|
|
|
+ "Load elisp variable container and assign the data to variable symbol."
|
|
|
+ (let ((lisp-symbol (cadr container))
|
|
|
+ (buffer (when (plist-get associated :file)
|
|
|
+ (get-file-buffer (plist-get associated :file)))))
|
|
|
+ (if buffer
|
|
|
+ (with-current-buffer buffer
|
|
|
+ (make-variable-buffer-local lisp-symbol)
|
|
|
+ (set lisp-symbol lisp-value))
|
|
|
+ (set lisp-symbol lisp-value))))
|
|
|
+
|
|
|
+(defalias 'org-persist-load:version #'org-persist-read:version)
|
|
|
+(defalias 'org-persist-load:file #'org-persist-read:file)
|
|
|
+
|
|
|
+(defun org-persist-load:index (container index-file _)
|
|
|
+ "Load `org-persist--index'."
|
|
|
+ (unless org-persist--index
|
|
|
+ (setq org-persist--index (org-persist-read:index container index-file nil))
|
|
|
+ (setq org-persist--index-hash nil)
|
|
|
+ (if org-persist--index
|
|
|
+ (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index)
|
|
|
+ (setq org-persist--index nil)
|
|
|
+ (plist-put (org-persist--get-collection container) :expiry 'never))))
|
|
|
+
|
|
|
+(defun org-persist--load-index ()
|
|
|
+ "Load `org-persist--index."
|
|
|
+ (org-persist-load:index
|
|
|
+ `("index" ,org-persist--storage-version)
|
|
|
+ (org-file-name-concat org-persist-directory org-persist-index-file)
|
|
|
+ nil))
|
|
|
+
|
|
|
+;;;; Writing container data
|
|
|
+
|
|
|
+(defmacro org-persist-write:generic (container collection)
|
|
|
+ "Write CONTAINER in COLLECTION."
|
|
|
+ `(let* ((c (org-persist--normalize-container ,container))
|
|
|
+ (write-func-symbol (intern (format "org-persist-write:%s" (car c)))))
|
|
|
+ (unless (fboundp write-func-symbol)
|
|
|
+ (error "org-persist: Write function %s not defined"
|
|
|
+ write-func-symbol))
|
|
|
+ (funcall write-func-symbol c ,collection)))
|
|
|
+
|
|
|
+(defun org-persist-write:elisp (container collection)
|
|
|
+ "Write elisp CONTAINER."
|
|
|
+ (if (and (plist-get (plist-get collection :associated) :file)
|
|
|
+ (get-file-buffer (plist-get (plist-get collection :associated) :file)))
|
|
|
+ (buffer-local-value
|
|
|
+ (cadr container)
|
|
|
+ (get-file-buffer (plist-get (plist-get collection :associated) :file)))
|
|
|
+ (symbol-value (cadr container))))
|
|
|
+
|
|
|
+(defalias 'org-persist-write:version #'ignore)
|
|
|
+
|
|
|
+(defun org-persist-write:file (container collection)
|
|
|
+ "Write file container."
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (when (and path (file-exists-p path))
|
|
|
+ (let* ((persist-file (plist-get collection :persist-file))
|
|
|
+ (ext (file-name-extension path))
|
|
|
+ (file-copy (org-file-name-concat
|
|
|
+ org-persist-directory
|
|
|
+ (format "%s-file.%s" persist-file ext))))
|
|
|
+ (unless (file-exists-p (file-name-directory file-copy))
|
|
|
+ (make-directory (file-name-directory file-copy) t))
|
|
|
+ (unless (file-exists-p file-copy)
|
|
|
+ (copy-file path file-copy 'overwrite))
|
|
|
+ (format "%s-file.%s" persist-file ext)))))
|
|
|
+
|
|
|
+(defun org-persist-write:url (container collection)
|
|
|
+ "Write url container."
|
|
|
+ (org-persist-collection-let collection
|
|
|
+ (when path
|
|
|
+ (let* ((persist-file (plist-get collection :persist-file))
|
|
|
+ (ext (file-name-extension path))
|
|
|
+ (file-copy (org-file-name-concat
|
|
|
+ org-persist-directory
|
|
|
+ (format "%s-file.%s" persist-file ext))))
|
|
|
+ (unless (file-exists-p (file-name-directory file-copy))
|
|
|
+ (make-directory (file-name-directory file-copy) t))
|
|
|
+ (unless (file-exists-p file-copy)
|
|
|
+ (url-copy-file path file-copy 'overwrite))
|
|
|
+ (format "%s-file.%s" persist-file ext)))))
|
|
|
+
|
|
|
+(defun org-persist-write:index (container _)
|
|
|
+ "Write index container."
|
|
|
+ (org-persist--get-collection container)
|
|
|
+ (unless (file-exists-p org-persist-directory)
|
|
|
+ (make-directory org-persist-directory))
|
|
|
+ (unless (file-exists-p org-persist-directory)
|
|
|
+ (warn "Failed to create org-persist storage in %s."
|
|
|
+ org-persist-directory)
|
|
|
+ (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)))))))
|
|
|
+ (unless (file-writable-p dir)
|
|
|
+ (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)
|
|
|
+ t))
|
|
|
+
|
|
|
+(defun org-persist--save-index ()
|
|
|
+ "Save `org-persist--index."
|
|
|
+ (org-persist-write:index
|
|
|
+ `("index" ,org-persist--storage-version) nil))
|
|
|
+
|
|
|
+;;;; Public API
|
|
|
+
|
|
|
+(cl-defun org-persist-register (container &optional associated &rest misc &key inherit &key (expiry 'never) &allow-other-keys)
|
|
|
+ "Register CONTAINER in ASSOCIATED to be persistent across Emacs sessions.
|
|
|
+Optional key INHERIT makes CONTAINER dependent on another container.
|
|
|
+Such dependency means that data shared between variables will be
|
|
|
+preserved (see elisp#Circular Objects).
|
|
|
+Optional key EXPIRY will set the expiry condition of the container.
|
|
|
+It can be `never', `nil' - until end of session, a number of days since
|
|
|
+last access, or a function accepting a single argument - collection.
|
|
|
+EXPIRY key has no effect when INHERIT is non-nil."
|
|
|
+ (unless org-persist--index (org-persist--load-index))
|
|
|
+ (setq container (org-persist--normalize-container container))
|
|
|
+ (when inherit
|
|
|
+ (setq inherit (org-persist--normalize-container inherit))
|
|
|
+ (let ((inherited-collection (org-persist--get-collection inherit associated))
|
|
|
+ new-collection)
|
|
|
+ (unless (member container (plist-get inherited-collection :container))
|
|
|
+ (setq new-collection
|
|
|
+ (plist-put (copy-sequence inherited-collection) :container
|
|
|
+ (cons container (plist-get inherited-collection :container))))
|
|
|
+ (org-persist--remove-from-index inherited-collection)
|
|
|
+ (org-persist--add-to-index new-collection))))
|
|
|
+ (let ((collection (org-persist--get-collection container associated misc)))
|
|
|
+ (when (and expiry (not inherit))
|
|
|
+ (when expiry (plist-put collection :expiry expiry))))
|
|
|
+ (when (or (bufferp associated) (bufferp (plist-get associated :buffer)))
|
|
|
+ (with-current-buffer (if (bufferp associated)
|
|
|
+ associated
|
|
|
+ (plist-get associated :buffer))
|
|
|
+ (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local))))
|
|
|
+
|
|
|
+(defun org-persist-unregister (container &optional associated)
|
|
|
+ "Unregister CONTAINER in ASSOCIATED to be persistent.
|
|
|
+When ASSOCIATED is `all', unregister CONTAINER everywhere."
|
|
|
+ (unless org-persist--index (org-persist--load-index))
|
|
|
+ (if (eq associated 'all)
|
|
|
+ (mapc (lambda (collection)
|
|
|
+ (when (member container (plist-get collection :container))
|
|
|
+ (org-persist-unregister container (plist-get collection :associated))))
|
|
|
+ org-persist--index)
|
|
|
+ (let ((collection (org-persist--get-collection container associated)))
|
|
|
+ (if (= (length (plist-get collection :container)) 1)
|
|
|
+ (org-persist--remove-from-index collection)
|
|
|
+ (plist-put collection :container
|
|
|
+ (remove container (plist-get collection :container)))
|
|
|
+ (org-persist--add-to-index collection)))))
|
|
|
+
|
|
|
+(defun org-persist-read (container &optional associated hash-must-match load?)
|
|
|
+ "Restore CONTAINER data for ASSOCIATED.
|
|
|
+When HASH-MUST-MATCH is non-nil, do not restore data if hash for
|
|
|
+ASSOCIATED file or buffer does not match.
|
|
|
+ASSOCIATED can be a plist, a buffer, or a string.
|
|
|
+A buffer is treated as (:buffer ASSOCIATED).
|
|
|
+A string is treated as (:file ASSOCIATED)."
|
|
|
+ (setq associated (org-persist--normalize-associated associated))
|
|
|
+ (setq container (org-persist--normalize-container container))
|
|
|
+ (let* ((collection (org-persist--get-collection container associated))
|
|
|
+ (persist-file (org-file-name-concat org-persist-directory (plist-get collection :persist-file)))
|
|
|
+ (data nil))
|
|
|
+ (when (and collection
|
|
|
+ (file-exists-p persist-file)
|
|
|
+ (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 (org-persist--read-elisp-file persist-file))
|
|
|
+ (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.
|
|
|
+The arguments have the same meaning as in `org-persist-read'."
|
|
|
+ (org-persist-read container associated hash-must-match t))
|
|
|
+
|
|
|
+(defun org-persist-load-all (&optional associated)
|
|
|
+ "Restore all the persistent data associated with ASSOCIATED."
|
|
|
+ (unless org-persist--index (org-persist--load-index))
|
|
|
+ (setq associated (org-persist--normalize-associated associated))
|
|
|
+ (let (all-containers)
|
|
|
+ (dolist (collection org-persist--index)
|
|
|
+ (when collection
|
|
|
+ (cl-pushnew (plist-get collection :container) all-containers :test #'equal)))
|
|
|
+ (dolist (container all-containers)
|
|
|
+ (org-persist-load container associated t))))
|
|
|
+
|
|
|
+(defun org-persist-load-all-buffer ()
|
|
|
+ "Call `org-persist-load-all' in current buffer."
|
|
|
+ (org-persist-load-all (current-buffer)))
|
|
|
+
|
|
|
+(defun org-persist-write (container &optional associated)
|
|
|
+ "Save CONTAINER according to ASSOCIATED.
|
|
|
+ASSOCIATED can be a plist, a buffer, or a string.
|
|
|
+A buffer is treated as (:buffer ASSOCIATED).
|
|
|
+A string is treated as (:file ASSOCIATED)."
|
|
|
+ (setq associated (org-persist--normalize-associated associated))
|
|
|
+ (let ((collection (org-persist--get-collection container associated)))
|
|
|
+ (setf collection (plist-put collection :associated associated))
|
|
|
+ (unless (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))))
|
|
|
+ (org-persist--write-elisp-file file data))))))
|
|
|
+
|
|
|
+(defun org-persist-write-all (&optional associated)
|
|
|
+ "Save all the persistent 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))
|
|
|
+ (org-persist-write (plist-get collection :container) (plist-get collection :associated))))
|
|
|
+ (dolist (container all-containers)
|
|
|
+ (when (org-persist--find-index `(:container ,container :associated ,associated))
|
|
|
+ (org-persist-write container associated)))))
|
|
|
+
|
|
|
+(defun org-persist-write-all-buffer ()
|
|
|
+ "Call `org-persist-write-all' in current buffer.
|
|
|
+Do nothing in an indirect buffer."
|
|
|
+ (unless (buffer-base-buffer (current-buffer))
|
|
|
+ (org-persist-write-all (current-buffer))))
|
|
|
+
|
|
|
+(defmacro org-persist-gc:generic (container collection)
|
|
|
+ "Garbage collect CONTAINER data from COLLECTION."
|
|
|
+ `(let* ((c (org-persist--normalize-container ,container))
|
|
|
+ (gc-func-symbol (intern (format "org-persist-gc:%s" (car c)))))
|
|
|
+ (unless (fboundp gc-func-symbol)
|
|
|
+ (error "org-persist: GC function %s not defined"
|
|
|
+ gc-func-symbol))
|
|
|
+ (funcall gc-func-symbol c ,collection)))
|
|
|
+
|
|
|
+(defalias 'org-persist-gc:elisp #'ignore)
|
|
|
+(defalias 'org-persist-gc:index #'ignore)
|
|
|
+
|
|
|
+(defun org-persist-gc:file (container collection)
|
|
|
+ "Garbage collect file container."
|
|
|
+ (let ((file (org-persist-read container (plist-get collection :associated))))
|
|
|
+ (when (file-exists-p file)
|
|
|
+ (delete-file file))))
|
|
|
+
|
|
|
+(defun org-persist-gc:url (container collection)
|
|
|
+ "Garbage collect url container."
|
|
|
+ (let ((file (org-persist-read container (plist-get collection :associated))))
|
|
|
+ (when (file-exists-p file)
|
|
|
+ (delete-file file))))
|
|
|
+
|
|
|
+(defmacro org-persist--gc-persist-file (persist-file)
|
|
|
+ "Garbage collect PERSIST-FILE."
|
|
|
+ `(when (file-exists-p ,persist-file)
|
|
|
+ (delete-file ,persist-file)
|
|
|
+ (when (org-directory-empty-p (file-name-directory ,persist-file))
|
|
|
+ (delete-directory (file-name-directory ,persist-file)))))
|
|
|
+
|
|
|
+(defmacro org-persist--gc-expired-p (cnd collection)
|
|
|
+ "Check if expiry condition CND triggers."
|
|
|
+ `(pcase ,cnd
|
|
|
+ (`nil t)
|
|
|
+ (`never nil)
|
|
|
+ ((pred numberp)
|
|
|
+ (<= (float-time) (+ (plist-get ,collection :access-time) (* ,cnd 24 60 60))))
|
|
|
+ ((pred functionp)
|
|
|
+ (funcall ,cnd ,collection))
|
|
|
+ (_ (error "org-persist: Unsupported expiry type %S" cnd))))
|
|
|
|
|
|
(defun org-persist-gc ()
|
|
|
- "Remove stored data for not existing files or unregistered variables."
|
|
|
- (let (new-index)
|
|
|
- (dolist (index org-persist--index)
|
|
|
- (let ((file (plist-get index :path))
|
|
|
- (persist-file (when (plist-get index :persist-file)
|
|
|
- (org-file-name-concat
|
|
|
- org-persist-directory
|
|
|
- (plist-get index :persist-file)))))
|
|
|
- (when (and file persist-file)
|
|
|
- (if (file-exists-p file)
|
|
|
- (push index new-index)
|
|
|
- (when (file-exists-p persist-file)
|
|
|
- (delete-file persist-file)
|
|
|
- (when (org-directory-empty-p (file-name-directory persist-file))
|
|
|
- (delete-directory (file-name-directory persist-file))))))))
|
|
|
+ "Remove expired or unregisted containers.
|
|
|
+Also, remove containers associated with non-existing files."
|
|
|
+ (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.
|
|
|
@@ -353,7 +777,7 @@ When BUFFER is `all', unregister VAR in all buffers."
|
|
|
;; hook after `org-persist-write-all'.
|
|
|
(add-hook 'kill-emacs-hook #'org-persist-gc)))
|
|
|
|
|
|
-(add-hook 'after-init-hook #'org-persist-read-all)
|
|
|
+(add-hook 'after-init-hook #'org-persist-load-all)
|
|
|
|
|
|
(provide 'org-persist)
|
|
|
|
Ihor Radchenko