From edd7f2962fe146805ab275974274596f994ebd9f Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Mon, 10 Jan 2022 21:30:04 +0800 Subject: [PATCH 01/30] org-persist: Reimplement using more generic approach --- lisp/org-element.el | 68 ++-- lisp/org-persist.el | 928 ++++++++++++++++++++++++++++++++------------ lisp/org.el | 7 +- 3 files changed, 721 insertions(+), 282 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index b82475a14..d556ab2ee 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)) + (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 (var &optional buffer) +(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) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 266c0a513..9fee5f793 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -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))) +;;;; Common functions -(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))))))) +(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))))) -(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)) +(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)))))))) + (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-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--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))) -(defun org-persist-read-all-buffer () - "Call `org-persist-read-all' in current buffer." - (org-persist-read-all (current-buffer))) +;;;; 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) diff --git a/lisp/org.el b/lisp/org.el index cb5d52c76..4bd8a6c99 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)) @@ -4893,6 +4893,11 @@ The following commands are available: (org-setup-filling) ;; Comments. (org-setup-comments-handling) + ;; Initialize cache. + (org-element-cache-reset) + (when (and org-element-cache-persistent + org-element-use-cache) + (org-persist-load 'org-element--cache (current-buffer) t)) ;; Beginning/end of defun (setq-local beginning-of-defun-function 'org-backward-element) (setq-local end-of-defun-function From 2a4e5a8e58f381497b5b53e96691ac2eaf98bdcd Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 18:17:50 +0800 Subject: [PATCH 02/30] org-persist--normalize-associated: Use cache to calculate buffer hash --- lisp/org-persist.el | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 9fee5f793..413c7790d 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -355,6 +355,9 @@ or file-path, (:inode inode), (:hash hash), or or (:key key)." 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 @@ -368,14 +371,26 @@ or file-path, (:inode inode), (:hash hash), or or (:key key)." 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 ((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))) From 7c2d93560c4b3f93271220aecee622d59c12873d Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 18:18:17 +0800 Subject: [PATCH 03/30] org-persist-default-expiry: Introduce and change default * lisp/org-persist.el: New customisation controlling default persist data expiry. Defaults to 30 days from last access. (org-persist-register): Change default value of `:expiry' key to `org-persist-default-expiry'. --- lisp/org-persist.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 413c7790d..7ac6940b0 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -143,6 +143,20 @@ password prompts to log in." (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.") @@ -571,7 +585,7 @@ COLLECTION is the plist holding data collectin." ;;;; Public API -(cl-defun org-persist-register (container &optional associated &rest misc &key inherit &key (expiry 'never) &allow-other-keys) +(cl-defun org-persist-register (container &optional associated &rest misc &key inherit &key (expiry org-persist-default-expiry) &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 From 1c79af13df9d3a611e4b773d395633e9095d367b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 18:18:58 +0800 Subject: [PATCH 04/30] org-persist-gc: Fix when expiry is days and data is freshly created --- lisp/org-persist.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 7ac6940b0..243e2b22c 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -756,10 +756,11 @@ Do nothing in an indirect buffer." (`nil t) (`never nil) ((pred numberp) - (<= (float-time) (+ (plist-get ,collection :access-time) (* ,cnd 24 60 60)))) + (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)))) + (_ (error "org-persist: Unsupported expiry type %S" ,cnd)))) (defun org-persist-gc () "Remove expired or unregisted containers. From 38a681fdaeae697f64974952bad63fce40f59ceb Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 20:32:33 +0800 Subject: [PATCH 05/30] org-element-cache-reset: Do not persist caches for non-file buffers --- lisp/org-element.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index d556ab2ee..307b93b3f 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7125,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) From dafa32da49bc6ff79c2a5ea9141349b2d04adca5 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 20:32:58 +0800 Subject: [PATCH 06/30] org-persist: Update index version --- lisp/org-persist.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 243e2b22c..85908db78 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -102,7 +102,7 @@ (require 'org-id) (require 'xdg nil t) -(defconst org-persist--storage-version "2.0" +(defconst org-persist--storage-version "2.1" "Persistent storage layout version.") (defgroup org-persist nil From 703df9310acdfc57b1a6e3028ea923f6a71587b4 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 20:33:22 +0800 Subject: [PATCH 07/30] org-persist: Cleanup on removal and version mismatch * lisp/org-persist.el (org-persist--remove-from-index): (org-persist-load:index): Garbage collect caches. --- lisp/org-persist.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 85908db78..0dabb54fe 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -328,6 +328,7 @@ Return PLIST." (when existing (org-persist-collection-let collection (dolist (cont (cons container 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)) @@ -494,6 +495,11 @@ COLLECTION is the plist holding data collectin." (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 () From 10845663224be8973a832718e6bed1cd30b18b82 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 20:34:41 +0800 Subject: [PATCH 08/30] Fix org-persist-unregister --- lisp/org-persist.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 0dabb54fe..6fbf67fe6 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -625,17 +625,20 @@ EXPIRY key has no effect when INHERIT is non-nil." "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--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))))) + (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. From 8821ff5811e3d8f95c3b7f01920d254bce611eb9 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 20:34:57 +0800 Subject: [PATCH 09/30] org-persist-read: Do not try to read non-existing containers --- lisp/org-persist.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 6fbf67fe6..c4c185dc1 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -649,8 +649,12 @@ 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))) + (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) From 1869a37a2c72dd799a9b8b3d4b18c535a910557b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 12 Jan 2022 21:30:04 +0800 Subject: [PATCH 10/30] Fix org-persist--remove-from-index --- lisp/org-persist.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index c4c185dc1..0e8fd5050 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -328,7 +328,8 @@ Return PLIST." (when existing (org-persist-collection-let collection (dolist (cont (cons container container)) - (org-persist-gc:generic cont collection) + (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)) From 203420504edcaa42703d8f1e783f656585db2a0b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 11:46:37 +0800 Subject: [PATCH 11/30] org-persist-load:elisp: fix loading --- lisp/org-persist.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 0e8fd5050..aecfa57a7 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -474,11 +474,11 @@ COLLECTION is the plist holding data collectin." load-func-symbol)) (funcall load-func-symbol container ,reference-data ,collection))) -(defun org-persist-load:elisp (container lisp-value associated) +(defun org-persist-load:elisp (container lisp-value collection) "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))))) + (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) From aca62116da79d6f0cbc4061238f2c781e03a4b75 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 11:47:00 +0800 Subject: [PATCH 12/30] org-persist-write: Update buffer hash on save --- lisp/org-persist.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index aecfa57a7..664111a7a 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -702,6 +702,11 @@ 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)) + ;; 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) From 9b650938e798092272023351519a8944d8804cd7 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 11:47:27 +0800 Subject: [PATCH 13/30] org-persist: Provide human readable access time and make sure it exist * lisp/org-persist.el (org-persist--storage-version): Bump version. (org-persist-read:generic): (org-persist-load:generic): (org-persist-write:generic): Save access time in human-readable form. --- lisp/org-persist.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 664111a7a..524c438e7 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -102,7 +102,7 @@ (require 'org-id) (require 'xdg nil t) -(defconst org-persist--storage-version "2.1" +(defconst org-persist--storage-version "2.2" "Persistent storage layout version.") (defgroup org-persist nil @@ -422,6 +422,7 @@ 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)) @@ -469,6 +470,7 @@ 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)) @@ -516,6 +518,8 @@ COLLECTION is the plist holding data collectin." "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)) From f963d617a4d0433ca060df18a82bbe1ddc89cc43 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 11:53:59 +0800 Subject: [PATCH 14/30] Fix checkdoc warnings --- lisp/org-persist.el | 50 ++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 524c438e7..8c97ac376 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -90,7 +90,7 @@ ;; 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 +;; 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 @@ -130,9 +130,9 @@ "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 +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 +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 @@ -146,7 +146,7 @@ password prompts to log in." (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 +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 @@ -341,7 +341,8 @@ Return PLIST." "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)." +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)) @@ -429,25 +430,25 @@ COLLECTION is the plist holding data collectin." (funcall read-func-symbol c ,reference-data ,collection))) (defun org-persist-read:elisp (_ lisp-value _) - "Read elisp container and return the stored data." + "Read elisp container and return LISP-VALUE." lisp-value) (defun org-persist-read:version (container _ _) - "Read version container." + "Read version CONTAINER." (cadr container)) (defun org-persist-read:file (_ path _) - "Read file container." + "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." + "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." + "Read index container CONT from INDEX-FILE." (when (file-exists-p index-file) (let ((index (org-persist--read-elisp-file index-file))) (when index @@ -477,7 +478,7 @@ COLLECTION is the plist holding data collectin." (funcall load-func-symbol container ,reference-data ,collection))) (defun org-persist-load:elisp (container lisp-value collection) - "Load elisp variable container and assign the data to variable symbol." + "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))))) @@ -491,7 +492,7 @@ COLLECTION is the plist holding data collectin." (defalias 'org-persist-load:file #'org-persist-read:file) (defun org-persist-load:index (container index-file _) - "Load `org-persist--index'." + "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) @@ -526,7 +527,7 @@ COLLECTION is the plist holding data collectin." (funcall write-func-symbol c ,collection))) (defun org-persist-write:elisp (container collection) - "Write elisp CONTAINER." + "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 @@ -537,7 +538,7 @@ COLLECTION is the plist holding data collectin." (defalias 'org-persist-write:version #'ignore) (defun org-persist-write:file (container collection) - "Write file container." + "Write file CONTAINER according to COLLECTION." (org-persist-collection-let collection (when (and path (file-exists-p path)) (let* ((persist-file (plist-get collection :persist-file)) @@ -552,7 +553,7 @@ COLLECTION is the plist holding data collectin." (format "%s-file.%s" persist-file ext))))) (defun org-persist-write:url (container collection) - "Write url container." + "Write url CONTAINER according to COLLECTION." (org-persist-collection-let collection (when path (let* ((persist-file (plist-get collection :persist-file)) @@ -567,7 +568,7 @@ COLLECTION is the plist holding data collectin." (format "%s-file.%s" persist-file ext))))) (defun org-persist-write:index (container _) - "Write index container." + "Write index CONTAINER." (org-persist--get-collection container) (unless (file-exists-p org-persist-directory) (make-directory org-persist-directory)) @@ -602,9 +603,10 @@ 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 +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." +EXPIRY key has no effect when INHERIT is non-nil. +MISC will be appended to CONTAINER." (unless org-persist--index (org-persist--load-index)) (setq container (org-persist--normalize-container container)) (when inherit @@ -651,7 +653,8 @@ 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)." +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))) @@ -723,7 +726,8 @@ A string is treated as (:file ASSOCIATED)." (org-persist--write-elisp-file file data)))))) (defun org-persist-write-all (&optional associated) - "Save all the persistent data." + "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) @@ -755,13 +759,13 @@ Do nothing in an indirect buffer." (defalias 'org-persist-gc:index #'ignore) (defun org-persist-gc:file (container collection) - "Garbage collect file container." + "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." + "Garbage collect url CONTAINER in COLLECTION." (let ((file (org-persist-read container (plist-get collection :associated)))) (when (file-exists-p file) (delete-file file)))) @@ -774,7 +778,7 @@ Do nothing in an indirect buffer." (delete-directory (file-name-directory ,persist-file))))) (defmacro org-persist--gc-expired-p (cnd collection) - "Check if expiry condition CND triggers." + "Check if expiry condition CND triggers for COLLECTION." `(pcase ,cnd (`nil t) (`never nil) From d5fc159bf7d73db807b09cda1ca8d831966701e1 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 12:23:51 +0800 Subject: [PATCH 15/30] Fix compiler warnings --- lisp/org-persist.el | 68 ++++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 8c97ac376..fad67e84c 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -271,32 +271,45 @@ FORMAT and ARGS are passed to `message'." (- (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))) + ;;;; 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)) + `(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)))))))) +"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'. @@ -537,8 +550,8 @@ COLLECTION is the plist holding data collectin." (defalias 'org-persist-write:version #'ignore) -(defun org-persist-write:file (container collection) - "Write file CONTAINER according to COLLECTION." +(defun org-persist-write:file (_ collection) + "Write file container according to COLLECTION." (org-persist-collection-let collection (when (and path (file-exists-p path)) (let* ((persist-file (plist-get collection :persist-file)) @@ -552,8 +565,8 @@ COLLECTION is the plist holding data collectin." (copy-file path file-copy 'overwrite)) (format "%s-file.%s" persist-file ext))))) -(defun org-persist-write:url (container collection) - "Write url CONTAINER according to COLLECTION." +(defun org-persist-write:url (_ collection) + "Write url container according to COLLECTION." (org-persist-collection-let collection (when path (let* ((persist-file (plist-get collection :persist-file)) @@ -746,15 +759,6 @@ 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) From 4ec57a94534c15e616c581d5d6fa138f4061e0b4 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 13:20:33 +0800 Subject: [PATCH 16/30] org-persist: Update commentary --- lisp/org-persist.el | 54 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 50 insertions(+), 4 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index fad67e84c..cd1a499e1 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,46 @@ ;;; 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 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) +;; 5. Load variable by side effects assigning variable symbol: +;; (org-persist-load 'variable-symbol (current-buffer)) +;; 6. Version variable value: +;; (org-persist-register '(("elisp" variable-symbol) (version "2.0"))) +;; 7. 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. @@ -73,7 +111,7 @@ ;; file; ;; - `:persist-file': data file name; ;; - `:associated' : list of associated objects; -;; - `:last-access' : last date when the container has been read; +;; - `:last-access' : last date when the container has been accessed; ;; - `:expiry' : list of expiry conditions. ;; - all other keywords are ignored ;; @@ -95,6 +133,14 @@ ;; 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: From dc52c0fe992dd07d5915c034526812764a2ae574 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 15 Jan 2022 13:26:37 +0800 Subject: [PATCH 17/30] Fix native-comp warnings --- lisp/org-persist.el | 5 +++++ lisp/org.el | 1 + 2 files changed, 6 insertions(+) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index cd1a499e1..4552dd4f2 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -148,6 +148,11 @@ (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.2" "Persistent storage layout version.") diff --git a/lisp/org.el b/lisp/org.el index 4bd8a6c99..4e27c6926 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -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) From fca80139eebf704d523de559ee9bfa6498565483 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sun, 23 Jan 2022 15:04:59 +0800 Subject: [PATCH 18/30] org-persist: Fix compatibility with Emacs 27 * lisp/org-persist.el (org-persist--normalize-associated): Do not expect that we can bind new vars in pacse forms. (org-persist-read:elisp): (org-persist-read:version): (org-persist-read:file): (org-persist-read:url): Avoid multiple `_' placeholders. --- lisp/org-persist.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 4552dd4f2..f80a8e2c1 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -443,7 +443,8 @@ MISC, if non-nil will be appended to the collection." "Normalize ASSOCIATED representation into (:type value)." (pcase associated ((or (pred stringp) `(:file ,associated2)) - (when associated2 (setq associated associated2)) + (unless (stringp associated) + (setq associated (cadr associated))) (let* ((rtn `(:file ,associated)) (inode (and (fboundp 'file-attribute-inode-number) (file-attribute-inode-number @@ -451,7 +452,8 @@ MISC, if non-nil will be appended to the collection." (when inode (plist-put rtn :inode inode)) rtn)) ((or (pred bufferp) `(:buffer ,associated2)) - (when associated2 (setq associated associated2)) + (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) @@ -493,20 +495,20 @@ COLLECTION is the plist holding data collectin." read-func-symbol)) (funcall read-func-symbol c ,reference-data ,collection))) -(defun org-persist-read:elisp (_ lisp-value _) +(defun org-persist-read:elisp (_ lisp-value __) "Read elisp container and return LISP-VALUE." lisp-value) -(defun org-persist-read:version (container _ _) +(defun org-persist-read:version (container _ __) "Read version CONTAINER." (cadr container)) -(defun org-persist-read:file (_ path _) +(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 _) +(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))) From ec787fb218dab5eb30e8f004638078c70d5846b0 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 25 Jan 2022 20:11:12 +0800 Subject: [PATCH 19/30] org-persist: Implement "file" and "url" containers linked to other file * lisp/org-persist.el: Update commentary. (org-persist--storage-version): Bump storage version. (org-persist-write:file): (org-persist-write:url): Support optional container setting. --- lisp/org-persist.el | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index f80a8e2c1..98d2f11af 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -41,7 +41,13 @@ ;; has been removed. ;; 3. Temporarily cache a file, including TRAMP path to disk: ;; (org-persist-write '("file") "/path/to/file") -;; 4. Cache value of a Elisp variable to disk. The value will be +;; 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) +;; (org-persist-write '("url" "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file")) +;; 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) +;; (org-persist-write '("url" "https://static.fsf.org/common/img/logo-new.png") (current-buffer)) +;; 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' @@ -54,11 +60,11 @@ ;; ;; Save buffer-local variable preserving circular links: ;; (org-persist-register 'org-element--headline-cache (current-buffer) ;; :inherit 'org-element--cache) -;; 5. Load variable by side effects assigning variable symbol: +;; 6. Load variable by side effects assigning variable symbol: ;; (org-persist-load 'variable-symbol (current-buffer)) -;; 6. Version variable value: +;; 7. Version variable value: ;; (org-persist-register '(("elisp" variable-symbol) (version "2.0"))) -;; 7. Cancel variable persistence: +;; 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 @@ -120,6 +126,7 @@ ;; 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. @@ -153,7 +160,7 @@ (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) -(defconst org-persist--storage-version "2.2" +(defconst org-persist--storage-version "2.3" "Persistent storage layout version.") (defgroup org-persist nil @@ -603,35 +610,39 @@ COLLECTION is the plist holding data collectin." (defalias 'org-persist-write:version #'ignore) -(defun org-persist-write:file (_ collection) - "Write file container according to COLLECTION." +(defun org-persist-write:file (c collection) + "Write file container C according to COLLECTION." (org-persist-collection-let collection - (when (and path (file-exists-p path)) + (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-file.%s" persist-file ext)))) + (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)) (unless (file-exists-p file-copy) (copy-file path file-copy 'overwrite)) - (format "%s-file.%s" persist-file ext))))) + (format "%s-%s.%s" persist-file (md5 path) ext))))) -(defun org-persist-write:url (_ collection) - "Write url container according to COLLECTION." +(defun org-persist-write:url (c collection) + "Write url container C according to COLLECTION." (org-persist-collection-let collection - (when path + (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-file.%s" persist-file ext)))) + (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)) (unless (file-exists-p file-copy) (url-copy-file path file-copy 'overwrite)) - (format "%s-file.%s" persist-file ext))))) + (format "%s-%s.%s" persist-file (md5 path) ext))))) (defun org-persist-write:index (container _) "Write index CONTAINER." From f3bd1dcb77b664f6bffc64188baa29d69ccdbb20 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 25 Jan 2022 20:12:20 +0800 Subject: [PATCH 20/30] org-persist: Fix compiler warnings --- lisp/org-persist.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 98d2f11af..5c3858959 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -449,7 +449,7 @@ MISC, if non-nil will be appended to the collection." (defun org-persist--normalize-associated (associated) "Normalize ASSOCIATED representation into (:type value)." (pcase associated - ((or (pred stringp) `(:file ,associated2)) + ((or (pred stringp) `(:file ,_)) (unless (stringp associated) (setq associated (cadr associated))) (let* ((rtn `(:file ,associated)) @@ -458,7 +458,7 @@ MISC, if non-nil will be appended to the collection." (file-attributes associated))))) (when inode (plist-put rtn :inode inode)) rtn)) - ((or (pred bufferp) `(:buffer ,associated2)) + ((or (pred bufferp) `(:buffer ,_)) (unless (bufferp associated) (setq associated (cadr associated))) (let ((cached (gethash associated org-persist--associated-buffer-cache)) From 1bc8389871472d77e230f162d818e20453c0c58d Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 25 Jan 2022 23:22:07 +0800 Subject: [PATCH 21/30] org-persist-read: Check expiry --- lisp/org-persist.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 5c3858959..bff1a094e 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -743,6 +743,9 @@ When LOAD? is non-nil, load the data instead of reading." (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) From 0526acd16f7fc529b902ea04daffc1f2256aa4ee Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 25 Jan 2022 23:41:41 +0800 Subject: [PATCH 22/30] org-persist-register: New optional keyword to force immidiate write * lisp/org-persist.el: Update commentary. (org-persist-register): Add new keyword `write-immediately' to write the newrly registerd container to disk immediately. --- lisp/org-persist.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index bff1a094e..d4b74b52a 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -42,11 +42,9 @@ ;; 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) -;; (org-persist-write '("url" "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file")) +;; (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) -;; (org-persist-write '("url" "https://static.fsf.org/common/img/logo-new.png") (current-buffer)) +;; (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). @@ -674,7 +672,11 @@ COLLECTION is the plist holding data collectin." ;;;; Public API -(cl-defun org-persist-register (container &optional associated &rest misc &key inherit &key (expiry org-persist-default-expiry) &allow-other-keys) +(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 @@ -683,6 +685,8 @@ 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." (unless org-persist--index (org-persist--load-index)) (setq container (org-persist--normalize-container container)) @@ -699,6 +703,7 @@ MISC will be appended to CONTAINER." (let ((collection (org-persist--get-collection container associated misc))) (when (and expiry (not inherit)) (when expiry (plist-put collection :expiry expiry)))) + (when write-immediately (org-persist-write container associated)) (when (or (bufferp associated) (bufferp (plist-get associated :buffer))) (with-current-buffer (if (bufferp associated) associated From eca678195b8691a81f65996203ca90bba4a4dcce Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 10:09:40 +0800 Subject: [PATCH 23/30] org-persist-write: Return the written value on success --- lisp/org-persist.el | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index d4b74b52a..6ff5e7bd2 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -336,6 +336,18 @@ FORMAT and ARGS are passed to `message'." 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) @@ -792,7 +804,9 @@ The arguments have the same meaning as in `org-persist-read'." "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)." +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." (setq associated (org-persist--normalize-associated associated)) ;; Update hash (when (and (plist-get associated :file) @@ -808,7 +822,8 @@ A string is treated as (:file ASSOCIATED)." (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)))))) + (org-persist--write-elisp-file file data) + (org-persist-read container associated)))))) (defun org-persist-write-all (&optional associated) "Save all the persistent data. @@ -853,18 +868,6 @@ Do nothing in an indirect buffer." (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 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)))) - (defun org-persist-gc () "Remove expired or unregisted containers. Also, remove containers associated with non-existing files." From 0e18c617cf9ef148ea2e46ea9fad95a1380b6e9b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 10:11:08 +0800 Subject: [PATCH 24/30] org-persist-write:index: Return index path on write --- lisp/org-persist.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 6ff5e7bd2..349548584 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -675,7 +675,7 @@ COLLECTION is the plist holding data collectin." (org-file-name-concat org-persist-directory org-persist-index-file) org-persist--index t t) - t)) + (org-file-name-concat org-persist-directory org-persist-index-file))) (defun org-persist--save-index () "Save `org-persist--index." From 6a5874bb26c028640ce689f93b64cea9874ff637 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 10:11:31 +0800 Subject: [PATCH 25/30] org-persist-write: Overwrite existing copy if write is requested --- lisp/org-persist.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 349548584..099b4aff8 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -634,8 +634,7 @@ COLLECTION is the plist holding data collectin." (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)) - (unless (file-exists-p file-copy) - (copy-file path file-copy 'overwrite)) + (copy-file path file-copy 'overwrite) (format "%s-%s.%s" persist-file (md5 path) ext))))) (defun org-persist-write:url (c collection) @@ -650,8 +649,7 @@ COLLECTION is the plist holding data collectin." (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)) - (unless (file-exists-p file-copy) - (url-copy-file path file-copy 'overwrite)) + (url-copy-file path file-copy 'overwrite) (format "%s-%s.%s" persist-file (md5 path) ext))))) (defun org-persist-write:index (container _) From caccec2c54e9f79885d5c557343d0b6f297ed276 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 10:12:19 +0800 Subject: [PATCH 26/30] org-persist: Use symbols as container names * lisp/org-persist.el: Update commentary. (org-persist--storage-version): Bump index version. (org-persist--normalize-container): (org-persist-read:index): (org-persist--load-index): (org-persist--save-index): Use symbol for container names. --- lisp/org-persist.el | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 099b4aff8..24c4ab1e3 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -35,16 +35,16 @@ ;; (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-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") +;; (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) +;; (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) +;; (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). @@ -61,7 +61,7 @@ ;; 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"))) +;; (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 @@ -86,9 +86,9 @@ ;; 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 +;; 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, @@ -120,15 +120,15 @@ ;; - all other keywords are ignored ;; ;; The available types of data containers are: -;; 1. ("elisp" variable-symbol) or just variable-symbol :: Storing +;; 1. (file variable-symbol) or just variable-symbol :: Storing ;; elisp variable data. -;; 2. ("file") :: Store a copy of the associated file preserving the +;; 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. +;; (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. +;; 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 @@ -158,7 +158,7 @@ (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) -(defconst org-persist--storage-version "2.3" +(defconst org-persist--storage-version "2.4" "Persistent storage layout version.") (defgroup org-persist nil @@ -445,11 +445,11 @@ MISC, if non-nil will be appended to the collection." (if (and (listp container) (listp (car container))) (mapcar #'org-persist--normalize-container container) (pcase container - ((pred symbolp) - (list "elisp" container)) - ((pred stringp) + ((or `elisp `version `file `index `url) (list container nil)) - (`(,(or "elisp" "version" "file" "index" "url") . ,_) + ((pred symbolp) + (list `elisp container)) + (`(,(or `elisp `version `file `index `url) . ,_) container) (_ (error "org-persist: Unknown container type: %S" container))))) @@ -540,7 +540,7 @@ COLLECTION is the plist holding data collectin." (org-persist-collection-let collection (when (and (not associated) (pcase container - (`(("index" ,version)) + (`((index ,version)) (equal version (cadr cont))) (_ nil))) (throw :found index))))))))) @@ -592,7 +592,7 @@ COLLECTION is the plist holding data collectin." (defun org-persist--load-index () "Load `org-persist--index." (org-persist-load:index - `("index" ,org-persist--storage-version) + `(index ,org-persist--storage-version) (org-file-name-concat org-persist-directory org-persist-index-file) nil)) @@ -678,7 +678,7 @@ COLLECTION is the plist holding data collectin." (defun org-persist--save-index () "Save `org-persist--index." (org-persist-write:index - `("index" ,org-persist--storage-version) nil)) + `(index ,org-persist--storage-version) nil)) ;;;; Public API From 6b175fb2277b17167e2fedff6326b09fac513c7f Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 10:49:52 +0800 Subject: [PATCH 27/30] org-persist-register: Make return value meaningful with :write-immidiately * lisp/org-persist.el (org-persist-register): Return the return value of `org-persist-write' when `:write-immediately' is non-nil. --- lisp/org-persist.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 24c4ab1e3..2c6cec4e4 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -697,7 +697,9 @@ 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." +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 @@ -713,12 +715,12 @@ MISC will be appended to CONTAINER." (let ((collection (org-persist--get-collection container associated misc))) (when (and expiry (not inherit)) (when expiry (plist-put collection :expiry expiry)))) - (when write-immediately (org-persist-write container associated)) (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)))) + (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. From f0e0716f543ef3d7a8b197c0840ab459e23c844f Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 19:24:09 +0800 Subject: [PATCH 28/30] org-element: Use new cache container format --- lisp/org-element.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 307b93b3f..77a9fc6e3 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7056,7 +7056,7 @@ The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" (defun org-element--cache-persist-before-write (container &optional associated) "Sync cache before saving." - (when (equal container '("elisp" org-element--cache)) + (when (equal container '(elisp org-element--cache)) (if (and org-element-use-cache (plist-get associated :file) (get-file-buffer (plist-get associated :file)) @@ -7079,7 +7079,7 @@ The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" (defun org-element--cache-persist-before-read (container &optional associated) "Avoid reading cache before Org mode is loaded." - (when (equal container '("elisp" org-element--cache)) + (when (equal container '(elisp org-element--cache)) (if (not (and (plist-get associated :file) (get-file-buffer (plist-get associated :file)))) 'forbid @@ -7097,9 +7097,9 @@ The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" (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) + (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) + (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) From 19a383d9f4bf3bd893542c757e2fed6ec1ff4cac Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 26 Jan 2022 19:24:39 +0800 Subject: [PATCH 29/30] org-persist-write-all: Speed up writing * lisp/org-persist.el (org-persist-write): New optional argument bypassing extra `org-persist-read' invocation. (org-persist-write-all): Call faster version of `org-persist-write'. --- lisp/org-persist.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 2c6cec4e4..fcc4d82d5 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -800,13 +800,15 @@ The arguments have the same meaning as in `org-persist-read'." "Call `org-persist-load-all' in current buffer." (org-persist-load-all (current-buffer))) -(defun org-persist-write (container &optional associated) +(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." +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) @@ -823,7 +825,7 @@ returned by `org-persist-read') on success." (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) (plist-get collection :container)))) (org-persist--write-elisp-file file data) - (org-persist-read container associated)))))) + (or ignore-return (org-persist-read container associated))))))) (defun org-persist-write-all (&optional associated) "Save all the persistent data. @@ -835,10 +837,10 @@ When ASSOCIATED is non-nil, only save the matching data." (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)))) + (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))))) + (org-persist-write container associated t))))) (defun org-persist-write-all-buffer () "Call `org-persist-write-all' in current buffer. From 7014675226eae17f3c7a6fa4c44a23daa7ae29ac Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 29 Jan 2022 17:11:07 +0800 Subject: [PATCH 30/30] org-mode: Fix cache loading order --- lisp/org.el | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 4e27c6926..b3c5f3104 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4882,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. @@ -4894,11 +4894,6 @@ The following commands are available: (org-setup-filling) ;; Comments. (org-setup-comments-handling) - ;; Initialize cache. - (org-element-cache-reset) - (when (and org-element-cache-persistent - org-element-use-cache) - (org-persist-load 'org-element--cache (current-buffer) t)) ;; Beginning/end of defun (setq-local beginning-of-defun-function 'org-backward-element) (setq-local end-of-defun-function