[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org ac5742f296 31/31: Merge branch 'feature/org-persist
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org ac5742f296 31/31: Merge branch 'feature/org-persist-new-tidy' |
|
Date: |
Sat, 29 Jan 2022 04:58:17 -0500 (EST) |
branch: externals/org
commit ac5742f296a75f9234191f5550c644b9a5bcbc35
Merge: 22e6ed6b89 7014675226
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>
Merge branch 'feature/org-persist-new-tidy'
---
lisp/org-element.el | 73 ++--
lisp/org-persist.el | 1072 +++++++++++++++++++++++++++++++++++++++------------
lisp/org.el | 5 +-
3 files changed, 862 insertions(+), 288 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index b82475a14e..77a9fc6e3e 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -7054,43 +7054,53 @@ The element is: %S\n The real element is: %S\n Cache
around :begin:\n%S\n%S\n%S"
;;; Cache persistance
-(defun org-element--cache-persist-before-write (var &optional buffer)
+(defun org-element--cache-persist-before-write (container &optional associated)
"Sync cache before saving."
- (when (and org-element-use-cache
- buffer
- org-element-cache-persistent
- (eq var 'org-element--cache)
- (derived-mode-p 'org-mode)
- org-element--cache)
- (with-current-buffer buffer
- ;; Cleanup cache request keys to avoid collisions during next
- ;; Emacs session.
- (avl-tree-mapc
- (lambda (el)
- (org-element-put-property el :org-element--cache-sync-key nil))
- org-element--cache)
- (org-with-wide-buffer
- (org-element-at-point (point-max))))
- nil))
-
-(defun org-element--cache-persist-before-read (var &optional buffer)
+ (when (equal container '(elisp org-element--cache))
+ (if (and org-element-use-cache
+ (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file))
+ org-element-cache-persistent)
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
+ (if (and (derived-mode-p 'org-mode)
+ org-element--cache)
+ (progn
+ ;; Cleanup cache request keys to avoid collisions during next
+ ;; Emacs session.
+ (avl-tree-mapc
+ (lambda (el)
+ (org-element-put-property el :org-element--cache-sync-key
nil))
+ org-element--cache)
+ (org-with-wide-buffer
+ (org-element-at-point (point-max)))
+ nil)
+ 'forbid))
+ 'forbid)))
+
+(defun org-element--cache-persist-before-read (container &optional associated)
"Avoid reading cache before Org mode is loaded."
- (when (memq var '(org-element--cache org-element--headline-cache))
- (if (not buffer) 'forbid
- (with-current-buffer buffer
+ (when (equal container '(elisp org-element--cache))
+ (if (not (and (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file))))
+ 'forbid
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
(unless (and org-element-use-cache
org-element-cache-persistent
- (derived-mode-p 'org-mode))
+ (derived-mode-p 'org-mode)
+ (equal (secure-hash 'md5 (current-buffer))
+ (plist-get associated :hash)))
'forbid)))))
-(defun org-element--cache-persist-after-read (var &optional buffer)
+(defun org-element--cache-persist-after-read (container &optional associated)
"Setup restored cache."
- (with-current-buffer buffer
- (when (and org-element-use-cache org-element-cache-persistent)
- (when (and (eq var 'org-element--cache) org-element--cache)
- (setq-local org-element--cache-size (avl-tree-size
org-element--cache)))
- (when (and (eq var 'org-element--headline-cache)
org-element--headline-cache)
- (setq-local org-element--headline-cache-size (avl-tree-size
org-element--headline-cache))))))
+ (when (and (plist-get associated :file)
+ (get-file-buffer (plist-get associated :file)))
+ (with-current-buffer (get-file-buffer (plist-get associated :file))
+ (when (and org-element-use-cache org-element-cache-persistent)
+ (when (and (equal container '(elisp org-element--cache))
org-element--cache)
+ (setq-local org-element--cache-size (avl-tree-size
org-element--cache)))
+ (when (and (equal container '(elisp org-element--headline-cache))
org-element--headline-cache)
+ (setq-local org-element--headline-cache-size (avl-tree-size
org-element--headline-cache)))))))
(add-hook 'org-persist-before-write-hook
#'org-element--cache-persist-before-write)
(add-hook 'org-persist-before-read-hook
#'org-element--cache-persist-before-read)
@@ -7115,7 +7125,8 @@ buffers."
(when (not org-element-cache-persistent)
(org-persist-unregister 'org-element--headline-cache
(current-buffer))
(org-persist-unregister 'org-element--cache (current-buffer)))
- (when org-element-cache-persistent
+ (when (and org-element-cache-persistent
+ (buffer-file-name (current-buffer)))
(org-persist-register 'org-element--cache (current-buffer))
(org-persist-register 'org-element--headline-cache
(current-buffer)
diff --git a/lisp/org-persist.el b/lisp/org-persist.el
index 266c0a513e..fcc4d82d55 100644
--- a/lisp/org-persist.el
+++ b/lisp/org-persist.el
@@ -1,4 +1,4 @@
-;;; org-persist.el --- Persist data across Emacs sessions -*-
lexical-binding: t; -*-
+;;; org-persist.el --- Persist cached data across Emacs sessions -*-
lexical-binding: t; -*-
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
@@ -22,8 +22,130 @@
;;; Commentary:
;;
-;; This file implements persistant data storage across Emacs sessions.
-;; Both global and buffer-local data can be stored.
+;; This file implements persistant cache storage across Emacs sessions.
+;; Both global and buffer-local data can be stored. This
+;; implementation is not meant to be used to store important data -
+;; all the caches should be safe to remove at any time.
+;;
+;; Example usage:
+;;
+;; 1. Temporarily cache Elisp symbol value to disk. Remove upon
+;; closing Emacs:
+;; (org-persist-write 'variable-symbol)
+;; (org-persist-read 'variable-symbol) ;; read the data later
+;; 2. Temporarily cache a remote URL file to disk. Remove upon
+;; closing Emacs:
+;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png";)
+;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png";)
+;; `org-persist-read' will return the cached file location or nil if cached
file
+;; has been removed.
+;; 3. Temporarily cache a file, including TRAMP path to disk:
+;; (org-persist-write 'file "/path/to/file")
+;; 4. Cache file or URL while some other file exists.
+;; (org-persist-register '(url
"https://static.fsf.org/common/img/logo-new.png";) '(:file "/path to the other
file") :expiry 'never :write-immediately t)
+;; or, if the other file is current buffer file
+;; (org-persist-register '(url
"https://static.fsf.org/common/img/logo-new.png";) (current-buffer) :expiry
'never :write-immediately t)
+;; 5. Cache value of a Elisp variable to disk. The value will be
+;; saved and restored automatically (except buffer-local
+;; variables).
+;; ;; Until `org-persist-default-expiry'
+;; (org-persist-register 'variable-symbol)
+;; ;; Specify expiry explicitly
+;; (org-persist-register 'variable-symbol :expiry 'never)
+;; ;; Save buffer-local variable (buffer-local will not be
+;; ;; autoloaded!)
+;; (org-persist-register 'org-element--cache (current-buffer))
+;; ;; Save buffer-local variable preserving circular links:
+;; (org-persist-register 'org-element--headline-cache (current-buffer)
+;; :inherit 'org-element--cache)
+;; 6. Load variable by side effects assigning variable symbol:
+;; (org-persist-load 'variable-symbol (current-buffer))
+;; 7. Version variable value:
+;; (org-persist-register '((elisp variable-symbol) (version "2.0")))
+;; 8. Cancel variable persistence:
+;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers
+;; (org-persist-unregister 'variable-symbol) ;; global variable
+;; (org-persist-unregister 'variable-symbol (current-buffer)) ;;
buffer-local
+;;
+;; 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 accessed;
+;; - `:expiry' : list of expiry conditions.
+;; - all other keywords are ignored
+;;
+;; The available types of data containers are:
+;; 1. (file variable-symbol) or just variable-symbol :: Storing
+;; elisp variable data.
+;; 2. (file) :: Store a copy of the associated file preserving the
+;; extension.
+;; (file "/path/to/a/file") :: Store a copy of the file in path.
+;; 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.
+;;
+;;
+;; Data collections associated with files will automatically expire
+;; when the file is removed. If the associated file is remote, the
+;; expiry is controlled by `org-persist-remote-files' instead.
+;;
+;; Data loading/writing can be more accurately controlled using
+;; `org-persist-before-write-hook', `org-persist-before-read-hook', and
`org-persist-after-read-hook'.
;;; Code:
@@ -36,57 +158,97 @@
(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+(defconst org-persist--storage-version "2.4"
+ "Persistent storage layout version.")
+
(defgroup org-persist nil
"Persistent cache for Org mode."
:tag "Org persist"
: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)))
+
+(defcustom org-persist-default-expiry 30
+ "Default expiry condition for persistent data.
+
+When this variable is nil, all the data vanishes at the end of Emacs
+session. When `never', the data never vanishes. When a number, the
+data is deleted that number days after last access. When a function,
+it should be a function returning non-nil when the data is expired. The
+function will be called with a single argument - collection."
+ :group 'org-persist
+ :type '(choice (const :tag "Never" 'never)
+ (const :tag "Always" nil)
+ (number :tag "Keep N days")
+ (function :tag "Function")))
+
+(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 +260,645 @@ 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)))
+
+(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)))
+
+(defmacro org-persist--gc-expired-p (cnd collection)
+ "Check if expiry condition CND triggers for COLLECTION."
+ `(pcase ,cnd
+ (`nil t)
+ (`never nil)
+ ((pred numberp)
+ (when (plist-get ,collection :access-time)
+ (<= (float-time) (+ (plist-get ,collection :access-time) (* ,cnd 24 60
60)))))
+ ((pred functionp)
+ (funcall ,cnd ,collection))
+ (_ (error "org-persist: Unsupported expiry type %S" ,cnd))))
+
+;;;; 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))
+ `(with-no-warnings
+ ;; FIXME: We only need to suppress warnings about unused
+ ;; let-bindings. However, it is unclear how to achieve it with
+ ;; `with-suppressed-warnings'.
+ (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))
+ (unless (listp (car container))
+ (org-persist-gc:generic cont collection))
+ (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).
+MISC, if non-nil will be appended to the collection."
+ (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
+ ((or `elisp `version `file `index `url)
+ (list container nil))
+ ((pred symbolp)
+ (list `elisp container))
+ (`(,(or `elisp `version `file `index `url) . ,_)
+ container)
+ (_ (error "org-persist: Unknown container type: %S" container)))))
+
+(defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key)
+ "Buffer hash cache.")
+
+(defun org-persist--normalize-associated (associated)
+ "Normalize ASSOCIATED representation into (:type value)."
+ (pcase associated
+ ((or (pred stringp) `(:file ,_))
+ (unless (stringp associated)
+ (setq associated (cadr associated)))
+ (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 ,_))
+ (unless (bufferp associated)
+ (setq associated (cadr associated)))
+ (let ((cached (gethash associated org-persist--associated-buffer-cache))
+ file inode hash)
+ (if (and cached (eq (buffer-modified-tick associated)
+ (car cached)))
+ (progn
+ (setq file (nth 1 cached)
+ inode (nth 2 cached)
+ hash (nth 3 cached)))
+ (setq file (buffer-file-name
+ (or (buffer-base-buffer associated)
+ associated)))
+ (setq inode (when (and file
+ (fboundp 'file-attribute-inode-number))
+ (file-attribute-inode-number
+ (file-attributes file))))
+ (setq hash (secure-hash 'md5 associated))
+ (puthash associated
+ (list (buffer-modified-tick associated)
+ file inode hash)
+ org-persist--associated-buffer-cache))
+ (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)))
+ (setf ,collection (plist-put ,collection :last-access-hr
(format-time-string "%FT%T%z" (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 LISP-VALUE."
+ lisp-value)
+
+(defun org-persist-read:version (container _ __)
+ "Read version CONTAINER."
+ (cadr container))
+
+(defun org-persist-read:file (_ path __)
+ "Read file container from PATH."
+ (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 from PATH."
+ (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 CONT from INDEX-FILE."
+ (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)))
+ (setf ,collection (plist-put ,collection :last-access-hr
(format-time-string "%FT%T%z" (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 collection)
+ "Assign elisp CONTAINER in COLLECTION LISP-VALUE."
+ (let ((lisp-symbol (cadr container))
+ (buffer (when (plist-get (plist-get collection :associated) :file)
+ (get-file-buffer (plist-get (plist-get collection
: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' 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)
+ (if org-persist--index
+ (mapc (lambda (collection) (org-persist--add-to-index collection
'hash)) org-persist--index)
+ (setq org-persist--index nil)
+ (when (file-exists-p org-persist-directory)
+ (dolist (file (directory-files org-persist-directory 'absolute
"^[^.][^.]"))
+ (if (file-directory-p file)
+ (delete-directory file t)
+ (delete-file file))))
+ (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)))))
+ (setf ,collection (plist-put ,collection :last-access (float-time)))
+ (setf ,collection (plist-put ,collection :last-access-hr
(format-time-string "%FT%T%z" (float-time))))
+ (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 according to COLLECTION."
+ (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 (c collection)
+ "Write file container C according to COLLECTION."
+ (org-persist-collection-let collection
+ (when (or (and path (file-exists-p path))
+ (and (stringp (cadr c)) (file-exists-p (cadr c))))
+ (when (and (stringp (cadr c)) (file-exists-p (cadr c)))
+ (setq path (cadr c)))
+ (let* ((persist-file (plist-get collection :persist-file))
+ (ext (file-name-extension path))
+ (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))
+ (copy-file path file-copy 'overwrite)
+ (format "%s-%s.%s" persist-file (md5 path) ext)))))
+
+(defun org-persist-write:url (c collection)
+ "Write url container C according to COLLECTION."
+ (org-persist-collection-let collection
+ (when (or path (cadr c))
+ (when (cadr c) (setq path (cadr c)))
+ (let* ((persist-file (plist-get collection :persist-file))
+ (ext (file-name-extension path))
+ (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))
+ (url-copy-file path file-copy 'overwrite)
+ (format "%s-%s.%s" persist-file (md5 path) 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)
+ (org-file-name-concat org-persist-directory org-persist-index-file)))
+
+(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 org-persist-default-expiry)
+ &key (write-immediately nil)
+ &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.
+Optional key WRITE-IMMEDIATELY controls whether to save the container
+data immediately.
+MISC will be appended to CONTAINER.
+When WRITE-IMMEDIATELY is non-nil, the return value will be the same
+with `org-persist-write'."
+ (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)))
+ (when write-immediately (org-persist-write container associated)))
+
+(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))
+ (setq container (org-persist--normalize-container container))
+ (setq associated (org-persist--normalize-associated associated))
+ (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--find-index `(:container ,container
:associated ,associated))))
+ (when collection
+ (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).
+When LOAD? is non-nil, load the data instead of reading."
+ (setq associated (org-persist--normalize-associated associated))
+ (setq container (org-persist--normalize-container container))
+ (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 (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 ignore-return)
+ "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).
+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'."
+ (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 (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)
+ (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))
+ (org-persist-write (plist-get collection :container) (plist-get
collection :associated) t)))
+ (dolist (container all-containers)
+ (when (org-persist--find-index `(:container ,container :associated
,associated))
+ (org-persist-write container associated t)))))
+
+(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))))
+
+(defalias 'org-persist-gc:elisp #'ignore)
+(defalias 'org-persist-gc:index #'ignore)
+
+(defun org-persist-gc:file (container collection)
+ "Garbage collect file CONTAINER in COLLECTION."
+ (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 in COLLECTION."
+ (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)))))
(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 +915,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)
diff --git a/lisp/org.el b/lisp/org.el
index cb5d52c76e..b3c5f31045 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -191,7 +191,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-latex-make-preamble "ox-latex" (info &optional template
snippet?))
(declare-function org-num-mode "org-num" (&optional arg))
(declare-function org-plot/gnuplot "org-plot" (&optional params))
-(declare-function org-persist-read "org-persist" (var &optional buffer))
+(declare-function org-persist-load "org-persist" (container &optional
associated hash-must-match))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function org-timer "org-timer" (&optional restart no-insert))
(declare-function org-timer-item "org-timer" (&optional arg))
@@ -204,6 +204,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defvar org-agenda-buffer-name)
(defvar org-element-paragraph-separate)
+(defvar org-element-cache-map-continue-from)
(defvar org-indent-indentation-per-level)
(defvar org-radio-target-regexp)
(defvar org-target-link-regexp)
@@ -4881,7 +4882,7 @@ The following commands are available:
(org-element-cache-reset)
(when (and org-element-cache-persistent
org-element-use-cache)
- (org-persist-read 'org-element--cache (current-buffer)))
+ (org-persist-load 'org-element--cache (current-buffer) t))
;; Initialize macros templates.
(org-macro-initialize-templates)
;; Initialize radio targets.
- [elpa] externals/org 1084566322 08/31: Fix org-persist-unregister, (continued)
- [elpa] externals/org 1084566322 08/31: Fix org-persist-unregister, ELPA Syncer, 2022/01/29
- [elpa] externals/org d5fc159bf7 15/31: Fix compiler warnings, ELPA Syncer, 2022/01/29
- [elpa] externals/org 203420504e 11/31: org-persist-load:elisp: fix loading, ELPA Syncer, 2022/01/29
- [elpa] externals/org fca80139ee 18/31: org-persist: Fix compatibility with Emacs 27, ELPA Syncer, 2022/01/29
- [elpa] externals/org dc52c0fe99 17/31: Fix native-comp warnings, ELPA Syncer, 2022/01/29
- [elpa] externals/org f3bd1dcb77 20/31: org-persist: Fix compiler warnings, ELPA Syncer, 2022/01/29
- [elpa] externals/org 1bc8389871 21/31: org-persist-read: Check expiry, ELPA Syncer, 2022/01/29
- [elpa] externals/org 6b175fb227 27/31: org-persist-register: Make return value meaningful with :write-immidiately, ELPA Syncer, 2022/01/29
- [elpa] externals/org f0e0716f54 28/31: org-element: Use new cache container format, ELPA Syncer, 2022/01/29
- [elpa] externals/org 19a383d9f4 29/31: org-persist-write-all: Speed up writing, ELPA Syncer, 2022/01/29
- [elpa] externals/org ac5742f296 31/31: Merge branch 'feature/org-persist-new-tidy',
ELPA Syncer <=
- [elpa] externals/org 38a681fdae 05/31: org-element-cache-reset: Do not persist caches for non-file buffers, ELPA Syncer, 2022/01/29
- [elpa] externals/org 8821ff5811 09/31: org-persist-read: Do not try to read non-existing containers, ELPA Syncer, 2022/01/29
- [elpa] externals/org 4ec57a9453 16/31: org-persist: Update commentary, ELPA Syncer, 2022/01/29
- [elpa] externals/org ec787fb218 19/31: org-persist: Implement "file" and "url" containers linked to other file, ELPA Syncer, 2022/01/29
- [elpa] externals/org 6a5874bb26 25/31: org-persist-write: Overwrite existing copy if write is requested, ELPA Syncer, 2022/01/29
- [elpa] externals/org 0e18c617cf 24/31: org-persist-write:index: Return index path on write, ELPA Syncer, 2022/01/29
- [elpa] externals/org eca678195b 23/31: org-persist-write: Return the written value on success, ELPA Syncer, 2022/01/29
- [elpa] externals/org 0526acd16f 22/31: org-persist-register: New optional keyword to force immidiate write, ELPA Syncer, 2022/01/29
- [elpa] externals/org caccec2c54 26/31: org-persist: Use symbols as container names, ELPA Syncer, 2022/01/29
- [elpa] externals/org 7014675226 30/31: org-mode: Fix cache loading order, ELPA Syncer, 2022/01/29