org-persist.el (47546B)
1 ;;; org-persist.el --- Persist cached data across Emacs sessions -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. 4 5 ;; Author: Ihor Radchenko <yantar92 at gmail dot com> 6 ;; Keywords: cache, storage 7 8 ;; This file is part of GNU Emacs. 9 10 ;; GNU Emacs is free software: you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 ;; 25 ;; This file implements persistent cache storage across Emacs sessions. 26 ;; Both global and buffer-local data can be stored. This 27 ;; implementation is not meant to be used to store important data - 28 ;; all the caches should be safe to remove at any time. 29 ;; 30 ;; Example usage: 31 ;; 32 ;; 1. Temporarily cache Elisp symbol value to disk. Remove upon 33 ;; closing Emacs: 34 ;; (org-persist-write 'variable-symbol) 35 ;; (org-persist-read 'variable-symbol) ;; read the data later 36 ;; 2. Temporarily cache a remote URL file to disk. Remove upon 37 ;; closing Emacs: 38 ;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png") 39 ;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png") 40 ;; `org-persist-read' will return the cached file location or nil if cached file 41 ;; has been removed. 42 ;; 3. Temporarily cache a file, including TRAMP path to disk: 43 ;; (org-persist-write 'file "/path/to/file") 44 ;; 4. Cache file or URL while some other file exists. 45 ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file") :expiry 'never :write-immediately t) 46 ;; or, if the other file is current buffer file 47 ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") (current-buffer) :expiry 'never :write-immediately t) 48 ;; 5. Cache value of a Elisp variable to disk. The value will be 49 ;; saved and restored automatically (except buffer-local 50 ;; variables). 51 ;; ;; Until `org-persist-default-expiry' 52 ;; (org-persist-register 'variable-symbol) 53 ;; ;; Specify expiry explicitly 54 ;; (org-persist-register 'variable-symbol :expiry 'never) 55 ;; ;; Save buffer-local variable (buffer-local will not be 56 ;; ;; autoloaded!) 57 ;; (org-persist-register 'org-element--cache (current-buffer)) 58 ;; ;; Save buffer-local variable preserving circular links: 59 ;; (org-persist-register 'org-element--headline-cache (current-buffer) 60 ;; :inherit 'org-element--cache) 61 ;; 6. Load variable by side effects assigning variable symbol: 62 ;; (org-persist-load 'variable-symbol (current-buffer)) 63 ;; 7. Version variable value: 64 ;; (org-persist-register '((elisp variable-symbol) (version "2.0"))) 65 ;; 8. Cancel variable persistence: 66 ;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers 67 ;; (org-persist-unregister 'variable-symbol) ;; global variable 68 ;; (org-persist-unregister 'variable-symbol (current-buffer)) ;; buffer-local 69 ;; 70 ;; Most common data type is variable data. However, other data types 71 ;; can also be stored. 72 ;; 73 ;; Persistent data is stored in individual files. Each of the files 74 ;; can contain a collection of related data, which is particularly 75 ;; useful when, say, several variables cross-reference each-other's 76 ;; data-cells and we want to preserve their circular structure. 77 ;; 78 ;; Each data collection can be associated with a local or remote file, 79 ;; its inode number, or contents hash. The persistent data collection 80 ;; can later be accessed using either file buffer, file, inode, or 81 ;; contents hash. 82 ;; 83 ;; The data collections can be versioned and removed upon expiry. 84 ;; 85 ;; In the code below I will use the following naming conventions: 86 ;; 1. Container :: a type of data to be stored 87 ;; Containers can store elisp variables, files, and version 88 ;; numbers. Each container can be customized with container 89 ;; options. For example, `elisp' container is customized with 90 ;; variable symbol. (elisp variable) is a container storing 91 ;; Lisp variable value. Similarly, (version "2.0") container 92 ;; will store version number. 93 ;; 2. Associated :: an object the container is associated with. The 94 ;; object can be a buffer, file, inode number, file contents hash, 95 ;; a generic key, or multiple of them. Associated can also be nil. 96 ;; 3. Data collection :: a list of containers linked to an associated 97 ;; object/objects. Each data collection can also have auxiliary 98 ;; records. Their only purpose is readability of the collection 99 ;; index. 100 ;; 4. Index file :: a file listing all the stored data collections. 101 ;; 5. Persist file :: a file holding data values or references to 102 ;; actual data values for a single data collection. This file 103 ;; contains an alist associating each data container in data 104 ;; collection with its value or a reference to the actual value. 105 ;; 106 ;; All the persistent data is stored in `org-persist-directory'. The data 107 ;; collections are listed in `org-persist-index-file' and the actual data is 108 ;; stored in UID-style subfolders. 109 ;; 110 ;; The `org-persist-index-file' stores the value of `org-persist--index'. 111 ;; 112 ;; Each collection is represented as a plist containing the following 113 ;; properties: 114 ;; - `:container' : list of data continers to be stored in single 115 ;; file; 116 ;; - `:persist-file': data file name; 117 ;; - `:associated' : list of associated objects; 118 ;; - `:last-access' : last date when the container has been accessed; 119 ;; - `:expiry' : list of expiry conditions. 120 ;; - all other keywords are ignored 121 ;; 122 ;; The available types of data containers are: 123 ;; 1. (file variable-symbol) or just variable-symbol :: Storing 124 ;; elisp variable data. 125 ;; 2. (file) :: Store a copy of the associated file preserving the 126 ;; extension. 127 ;; (file "/path/to/a/file") :: Store a copy of the file in path. 128 ;; 3. (version "version number") :: Version the data collection. 129 ;; If the stored collection has different version than "version 130 ;; number", disregard it. 131 ;; 4. (url) :: Store a downloaded copy of URL object. 132 ;; 133 ;; The data collections can expire, in which case they will be removed 134 ;; from the persistent storage at the end of Emacs session. The 135 ;; expiry condition can be set when saving/registering data 136 ;; containers. The expirty condition can be `never' - data will never 137 ;; expire; nil - data will expire at the end of current Emacs session; 138 ;; a number - data will expire after the number days from last access; 139 ;; a function - data will expire if the function, called with a single 140 ;; argument - collection, returns non-nil. 141 ;; 142 ;; 143 ;; Data collections associated with files will automatically expire 144 ;; when the file is removed. If the associated file is remote, the 145 ;; expiry is controlled by `org-persist-remote-files' instead. 146 ;; 147 ;; Data loading/writing can be more accurately controlled using 148 ;; `org-persist-before-write-hook', `org-persist-before-read-hook', and `org-persist-after-read-hook'. 149 150 ;;; Code: 151 152 (require 'org-macs) 153 (org-assert-version) 154 155 (require 'org-compat) 156 (require 'org-id) 157 (require 'xdg nil t) 158 159 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 160 (declare-function org-next-visible-heading "org" (arg)) 161 (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) 162 163 164 (defconst org-persist--storage-version "3.1" 165 "Persistent storage layout version.") 166 167 (defgroup org-persist nil 168 "Persistent cache for Org mode." 169 :tag "Org persist" 170 :group 'org) 171 172 (defcustom org-persist-directory (expand-file-name 173 (org-file-name-concat 174 (let ((cache-dir (when (fboundp 'xdg-cache-home) 175 (xdg-cache-home)))) 176 (if (or (seq-empty-p cache-dir) 177 (not (file-exists-p cache-dir)) 178 (file-exists-p (org-file-name-concat 179 user-emacs-directory 180 "org-persist"))) 181 user-emacs-directory 182 cache-dir)) 183 "org-persist/")) 184 "Directory where the data is stored." 185 :group 'org-persist 186 :package-version '(Org . "9.6") 187 :type 'directory) 188 189 (defcustom org-persist-remote-files 100 190 "Whether to keep persistent data for remote files. 191 192 When this variable is nil, never save persistent data associated with 193 remote files. When t, always keep the data. When 194 `check-existence', contact remote server containing the file and only 195 keep the data when the file exists on the server. When a number, keep 196 up to that number persistent values for remote files. 197 198 Note that the last option `check-existence' may cause Emacs to show 199 password prompts to log in." 200 :group 'org-persist 201 :package-version '(Org . "9.6") 202 :type '(choice (const :tag "Never" nil) 203 (const :tag "Always" t) 204 (number :tag "Keep not more than X files") 205 (const :tag "Check if exist on remote" check-existence))) 206 207 (defcustom org-persist-default-expiry 30 208 "Default expiry condition for persistent data. 209 210 When this variable is nil, all the data vanishes at the end of Emacs 211 session. When `never', the data never vanishes. When a number, the 212 data is deleted that number days after last access. When a function, 213 it should be a function returning non-nil when the data is expired. The 214 function will be called with a single argument - collection." 215 :group 'org-persist 216 :package-version '(Org . "9.6") 217 :type '(choice (const :tag "Never" never) 218 (const :tag "Always" nil) 219 (number :tag "Keep N days") 220 (function :tag "Function"))) 221 222 (defconst org-persist-index-file "index" 223 "File name used to store the data index.") 224 225 (defvar org-persist--disable-when-emacs-Q t 226 "Disable persistence when Emacs is called with -Q command line arg. 227 When non-nil, this sets `org-persist-directory' to temporary directory. 228 229 This variable must be set before loading org-persist library.") 230 231 (defvar org-persist-before-write-hook nil 232 "Abnormal hook ran before saving data. 233 The hook must accept the same arguments as `org-persist-write'. 234 The hooks will be evaluated until a hook returns non-nil. 235 If any of the hooks return non-nil, do not save the data.") 236 237 (defvar org-persist-before-read-hook nil 238 "Abnormal hook ran before reading data. 239 The hook must accept the same arguments as `org-persist-read'. 240 The hooks will be evaluated until a hook returns non-nil. 241 If any of the hooks return non-nil, do not read the data.") 242 243 (defvar org-persist-after-read-hook nil 244 "Abnormal hook ran after reading data. 245 The hook must accept the same arguments as `org-persist-read'.") 246 247 (defvar org-persist--index nil 248 "Global index. 249 250 The index is a list of plists. Each plist contains information about 251 persistent data storage. Each plist contains the following 252 properties: 253 254 - `:container' : list of data continers to be stored in single file 255 - `:persist-file': data file name 256 - `:associated' : list of associated objects 257 - `:last-access' : last date when the container has been read 258 - `:expiry' : list of expiry conditions 259 - all other keywords are ignored.") 260 261 (defvar org-persist--index-hash nil 262 "Hash table storing `org-persist--index'. Used for quick access. 263 They keys are conses of (container . associated).") 264 265 (defvar org-persist--report-time 0.5 266 "Whether to report read/write time. 267 268 When the value is a number, it is a threshold number of seconds. If 269 the read/write time of a single variable exceeds the threshold, a 270 message is displayed. 271 272 When the value is a non-nil non-number, always display the message. 273 When the value is nil, never display the message.") 274 275 ;;;; Common functions 276 277 (defun org-persist--display-time (duration format &rest args) 278 "Report DURATION according to FORMAT + ARGS message. 279 FORMAT and ARGS are passed to `message'." 280 (when (or (and org-persist--report-time 281 (numberp org-persist--report-time) 282 (>= duration org-persist--report-time)) 283 (and org-persist--report-time 284 (not (numberp org-persist--report-time)))) 285 (apply #'message 286 (format "org-persist: %s took %%.2f sec" format) 287 (append args (list duration))))) 288 289 (defun org-persist--read-elisp-file (&optional buffer-or-file) 290 "Read elisp data from BUFFER-OR-FILE or current buffer." 291 (unless buffer-or-file (setq buffer-or-file (current-buffer))) 292 (with-temp-buffer 293 (if (bufferp buffer-or-file) 294 (set-buffer buffer-or-file) 295 (insert-file-contents buffer-or-file)) 296 (condition-case err 297 (let ((coding-system-for-read 'utf-8) 298 (read-circle t) 299 (start-time (float-time))) 300 ;; FIXME: Reading sometimes fails to read circular objects. 301 ;; I suspect that it happens when we have object reference 302 ;; #N# read before object definition #N=. If it is really 303 ;; so, it should be Emacs bug - either in `read' or in 304 ;; `prin1'. Meanwhile, just fail silently when `read' 305 ;; fails to parse the saved cache object. 306 (prog1 307 (read (current-buffer)) 308 (org-persist--display-time 309 (- (float-time) start-time) 310 "Reading from %S" buffer-or-file))) 311 ;; Recover gracefully if index file is corrupted. 312 (error 313 ;; Remove problematic file. 314 (unless (bufferp buffer-or-file) (delete-file buffer-or-file)) 315 ;; Do not report the known error to user. 316 (if (string-match-p "Invalid read syntax" (error-message-string err)) 317 (message "Emacs reader failed to read data in %S. The error was: %S" 318 buffer-or-file (error-message-string err)) 319 (warn "Emacs reader failed to read data in %S. The error was: %S" 320 buffer-or-file (error-message-string err))) 321 nil)))) 322 323 (defun org-persist--write-elisp-file (file data &optional no-circular pp) 324 "Write elisp DATA to FILE." 325 (let ((print-circle (not no-circular)) 326 print-level 327 print-length 328 print-quoted 329 (print-escape-control-characters t) 330 (print-escape-nonascii t) 331 (print-continuous-numbering t) 332 print-number-table 333 (start-time (float-time))) 334 (unless (file-exists-p (file-name-directory file)) 335 (make-directory (file-name-directory file) t)) 336 (with-temp-file file 337 (if pp 338 (pp data (current-buffer)) 339 (prin1 data (current-buffer)))) 340 (org-persist--display-time 341 (- (float-time) start-time) 342 "Writing to %S" file))) 343 344 (defmacro org-persist-gc:generic (container collection) 345 "Garbage collect CONTAINER data from COLLECTION." 346 `(let* ((c (org-persist--normalize-container ,container)) 347 (gc-func-symbol (intern (format "org-persist-gc:%s" (car c))))) 348 (unless (fboundp gc-func-symbol) 349 (error "org-persist: GC function %s not defined" 350 gc-func-symbol)) 351 (funcall gc-func-symbol c ,collection))) 352 353 (defmacro org-persist--gc-expired-p (cnd collection) 354 "Check if expiry condition CND triggers for COLLECTION." 355 `(pcase ,cnd 356 (`nil t) 357 (`never nil) 358 ((pred numberp) 359 (when (plist-get ,collection :last-access) 360 (> (float-time) (+ (plist-get ,collection :last-access) (* ,cnd 24 60 60))))) 361 ((pred functionp) 362 (funcall ,cnd ,collection)) 363 (_ (error "org-persist: Unsupported expiry type %S" ,cnd)))) 364 365 ;;;; Working with index 366 367 (defmacro org-persist-collection-let (collection &rest body) 368 "Bind container and associated from COLLECTION and execute BODY." 369 (declare (debug (form body)) (indent 1)) 370 `(with-no-warnings 371 (let* ((container (plist-get ,collection :container)) 372 (associated (plist-get ,collection :associated)) 373 (path (plist-get associated :file)) 374 (inode (plist-get associated :inode)) 375 (hash (plist-get associated :hash)) 376 (key (plist-get associated :key))) 377 ;; Suppress "unused variable" warnings. 378 (ignore container associated path inode hash key) 379 ,@body))) 380 381 (defun org-persist--find-index (collection) 382 "Find COLLECTION in `org-persist--index'." 383 (org-persist-collection-let collection 384 (and org-persist--index-hash 385 (catch :found 386 (dolist (cont (cons container container)) 387 (let (r) 388 (setq r (or (gethash (cons cont associated) org-persist--index-hash) 389 (and path (gethash (cons cont (list :file path)) org-persist--index-hash)) 390 (and inode (gethash (cons cont (list :inode inode)) org-persist--index-hash)) 391 (and hash (gethash (cons cont (list :hash hash)) org-persist--index-hash)) 392 (and key (gethash (cons cont (list :key key)) org-persist--index-hash)))) 393 (when r (throw :found r)))))))) 394 395 (defun org-persist--add-to-index (collection &optional hash-only) 396 "Add or update COLLECTION in `org-persist--index'. 397 When optional HASH-ONLY is non-nil, only modify the hash table. 398 Return PLIST." 399 (org-persist-collection-let collection 400 (let ((existing (org-persist--find-index collection))) 401 (if existing 402 (progn 403 (plist-put existing :container container) 404 (plist-put (plist-get existing :associated) :file path) 405 (plist-put (plist-get existing :associated) :inode inode) 406 (plist-put (plist-get existing :associated) :hash hash) 407 (plist-put (plist-get existing :associated) :key key) 408 existing) 409 (unless hash-only (push collection org-persist--index)) 410 (unless org-persist--index-hash (setq org-persist--index-hash (make-hash-table :test 'equal))) 411 (dolist (cont (cons container container)) 412 (puthash (cons cont associated) collection org-persist--index-hash) 413 (when path (puthash (cons cont (list :file path)) collection org-persist--index-hash)) 414 (when inode (puthash (cons cont (list :inode inode)) collection org-persist--index-hash)) 415 (when hash (puthash (cons cont (list :hash inode)) collection org-persist--index-hash)) 416 (when key (puthash (cons cont (list :key inode)) collection org-persist--index-hash))) 417 collection)))) 418 419 (defun org-persist--remove-from-index (collection) 420 "Remove COLLECTION from `org-persist--index'." 421 (let ((existing (org-persist--find-index collection))) 422 (when existing 423 (org-persist-collection-let collection 424 (dolist (cont (cons container container)) 425 (unless (listp (car container)) 426 (org-persist-gc:generic cont collection)) 427 (remhash (cons cont associated) org-persist--index-hash) 428 (when path (remhash (cons cont (list :file path)) org-persist--index-hash)) 429 (when inode (remhash (cons cont (list :inode inode)) org-persist--index-hash)) 430 (when hash (remhash (cons cont (list :hash hash)) org-persist--index-hash)) 431 (when key (remhash (cons cont (list :key key)) org-persist--index-hash)))) 432 (setq org-persist--index (delq existing org-persist--index))))) 433 434 (defun org-persist--get-collection (container &optional associated misc) 435 "Return or create collection used to store CONTAINER for ASSOCIATED. 436 When ASSOCIATED is nil, it is a global CONTAINER. 437 ASSOCIATED can also be a (:buffer buffer) or buffer, (:file file-path) 438 or file-path, (:inode inode), (:hash hash), or or (:key key). 439 MISC, if non-nil will be appended to the collection. It must be a plist." 440 (unless (and (listp container) (listp (car container))) 441 (setq container (list container))) 442 (setq associated (org-persist--normalize-associated associated)) 443 (when (and misc (or (not (listp misc)) (= 1 (% (length misc) 2)))) 444 (error "org-persist: Not a plist: %S" misc)) 445 (or (org-persist--find-index 446 `( :container ,(org-persist--normalize-container container) 447 :associated ,associated)) 448 (org-persist--add-to-index 449 (nconc 450 (list :container (org-persist--normalize-container container) 451 :persist-file 452 (replace-regexp-in-string "^.." "\\&/" (org-id-uuid)) 453 :associated associated) 454 misc)))) 455 456 ;;;; Reading container data. 457 458 (defun org-persist--normalize-container (container) 459 "Normalize CONTAINER representation into (type . settings)." 460 (if (and (listp container) (listp (car container))) 461 (mapcar #'org-persist--normalize-container container) 462 (pcase container 463 ((or `elisp `version `file `index `url) 464 (list container nil)) 465 ((pred symbolp) 466 (list `elisp container)) 467 (`(,(or `elisp `version `file `index `url) . ,_) 468 container) 469 (_ (error "org-persist: Unknown container type: %S" container))))) 470 471 (defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key) 472 "Buffer hash cache.") 473 474 (defun org-persist--normalize-associated (associated) 475 "Normalize ASSOCIATED representation into (:type value)." 476 (pcase associated 477 ((or (pred stringp) `(:file ,_)) 478 (unless (stringp associated) 479 (setq associated (cadr associated))) 480 (let* ((rtn `(:file ,associated)) 481 (inode (and (fboundp 'file-attribute-inode-number) 482 (file-attribute-inode-number 483 (file-attributes associated))))) 484 (when inode (plist-put rtn :inode inode)) 485 rtn)) 486 ((or (pred bufferp) `(:buffer ,_)) 487 (unless (bufferp associated) 488 (setq associated (cadr associated))) 489 (let ((cached (gethash associated org-persist--associated-buffer-cache)) 490 file inode hash) 491 (if (and cached (eq (buffer-modified-tick associated) 492 (car cached))) 493 (progn 494 (setq file (nth 1 cached) 495 inode (nth 2 cached) 496 hash (nth 3 cached))) 497 (setq file (buffer-file-name 498 (or (buffer-base-buffer associated) 499 associated))) 500 (setq inode (when (and file 501 (fboundp 'file-attribute-inode-number)) 502 (file-attribute-inode-number 503 (file-attributes file)))) 504 (setq hash (secure-hash 'md5 associated)) 505 (puthash associated 506 (list (buffer-modified-tick associated) 507 file inode hash) 508 org-persist--associated-buffer-cache)) 509 (let ((rtn `(:hash ,hash))) 510 (when file (setq rtn (plist-put rtn :file file))) 511 (when inode (setq rtn (plist-put rtn :inode inode))) 512 rtn))) 513 ((pred listp) 514 associated) 515 (_ (error "Unknown associated object %S" associated)))) 516 517 (defmacro org-persist-read:generic (container reference-data collection) 518 "Read and return the data stored in CONTAINER. 519 REFERENCE-DATA is associated with CONTAINER in the persist file. 520 COLLECTION is the plist holding data collection." 521 `(let* ((c (org-persist--normalize-container ,container)) 522 (read-func-symbol (intern (format "org-persist-read:%s" (car c))))) 523 (setf ,collection (plist-put ,collection :last-access (float-time))) 524 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) 525 (unless (fboundp read-func-symbol) 526 (error "org-persist: Read function %s not defined" 527 read-func-symbol)) 528 (funcall read-func-symbol c ,reference-data ,collection))) 529 530 (defun org-persist-read:elisp (_ lisp-value __) 531 "Read elisp container and return LISP-VALUE." 532 lisp-value) 533 534 (defun org-persist-read:version (container _ __) 535 "Read version CONTAINER." 536 (cadr container)) 537 538 (defun org-persist-read:file (_ path __) 539 "Read file container from PATH." 540 (when (and path (file-exists-p (concat org-persist-directory path))) 541 (concat org-persist-directory path))) 542 543 (defun org-persist-read:url (_ path __) 544 "Read file container from PATH." 545 (when (and path (file-exists-p (concat org-persist-directory path))) 546 (concat org-persist-directory path))) 547 548 (defun org-persist-read:index (cont index-file _) 549 "Read index container CONT from INDEX-FILE." 550 (when (file-exists-p index-file) 551 (let ((index (org-persist--read-elisp-file index-file))) 552 (when index 553 (catch :found 554 (dolist (collection index) 555 (org-persist-collection-let collection 556 (when (and (not associated) 557 (pcase container 558 (`((index ,version)) 559 (equal version (cadr cont))) 560 (_ nil))) 561 (throw :found index))))))))) 562 563 ;;;; Applying container data for side effects. 564 565 (defmacro org-persist-load:generic (container reference-data collection) 566 "Load the data stored in CONTAINER for side effects. 567 REFERENCE-DATA is associated with CONTAINER in the persist file. 568 COLLECTION is the plist holding data collection." 569 `(let* ((container (org-persist--normalize-container ,container)) 570 (load-func-symbol (intern (format "org-persist-load:%s" (car container))))) 571 (setf ,collection (plist-put ,collection :last-access (float-time))) 572 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) 573 (unless (fboundp load-func-symbol) 574 (error "org-persist: Load function %s not defined" 575 load-func-symbol)) 576 (funcall load-func-symbol container ,reference-data ,collection))) 577 578 (defun org-persist-load:elisp (container lisp-value collection) 579 "Assign elisp CONTAINER in COLLECTION LISP-VALUE." 580 (let ((lisp-symbol (cadr container)) 581 (buffer (when (plist-get (plist-get collection :associated) :file) 582 (get-file-buffer (plist-get (plist-get collection :associated) :file))))) 583 (if buffer 584 (with-current-buffer buffer 585 (make-variable-buffer-local lisp-symbol) 586 (set lisp-symbol lisp-value)) 587 (set lisp-symbol lisp-value)))) 588 589 (defalias 'org-persist-load:version #'org-persist-read:version) 590 (defalias 'org-persist-load:file #'org-persist-read:file) 591 592 (defun org-persist-load:index (container index-file _) 593 "Load `org-persist--index' from INDEX-FILE according to CONTAINER." 594 (unless org-persist--index 595 (setq org-persist--index (org-persist-read:index container index-file nil)) 596 (setq org-persist--index-hash nil) 597 (if org-persist--index 598 (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index) 599 (setq org-persist--index nil) 600 (when (file-exists-p org-persist-directory) 601 (dolist (file (directory-files org-persist-directory 'absolute 602 "\\`[^.][^.]")) 603 (if (file-directory-p file) 604 (delete-directory file t) 605 (delete-file file)))) 606 (plist-put (org-persist--get-collection container) :expiry 'never)))) 607 608 (defun org-persist--load-index () 609 "Load `org-persist--index." 610 (org-persist-load:index 611 `(index ,org-persist--storage-version) 612 (org-file-name-concat org-persist-directory org-persist-index-file) 613 nil)) 614 615 ;;;; Writing container data 616 617 (defmacro org-persist-write:generic (container collection) 618 "Write CONTAINER in COLLECTION." 619 `(let* ((c (org-persist--normalize-container ,container)) 620 (write-func-symbol (intern (format "org-persist-write:%s" (car c))))) 621 (setf ,collection (plist-put ,collection :last-access (float-time))) 622 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) 623 (unless (fboundp write-func-symbol) 624 (error "org-persist: Write function %s not defined" 625 write-func-symbol)) 626 (funcall write-func-symbol c ,collection))) 627 628 (defun org-persist-write:elisp (container collection) 629 "Write elisp CONTAINER according to COLLECTION." 630 (if (and (plist-get (plist-get collection :associated) :file) 631 (get-file-buffer (plist-get (plist-get collection :associated) :file))) 632 (let ((buf (get-file-buffer (plist-get (plist-get collection :associated) :file)))) 633 ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. 634 ;; Not using it yet to keep backward compatibility. 635 (condition-case nil 636 (buffer-local-value (cadr container) buf) 637 (void-variable nil))) 638 (when (boundp (cadr container)) 639 (symbol-value (cadr container))))) 640 641 (defalias 'org-persist-write:version #'ignore) 642 643 (defun org-persist-write:file (c collection) 644 "Write file container C according to COLLECTION." 645 (org-persist-collection-let collection 646 (when (or (and path (file-exists-p path)) 647 (and (stringp (cadr c)) (file-exists-p (cadr c)))) 648 (when (and (stringp (cadr c)) (file-exists-p (cadr c))) 649 (setq path (cadr c))) 650 (let* ((persist-file (plist-get collection :persist-file)) 651 (ext (file-name-extension path)) 652 (file-copy (org-file-name-concat 653 org-persist-directory 654 (format "%s-%s.%s" persist-file (md5 path) ext)))) 655 (unless (file-exists-p file-copy) 656 (unless (file-exists-p (file-name-directory file-copy)) 657 (make-directory (file-name-directory file-copy) t)) 658 (copy-file path file-copy 'overwrite)) 659 (format "%s-%s.%s" persist-file (md5 path) ext))))) 660 661 (defun org-persist-write:url (c collection) 662 "Write url container C according to COLLECTION." 663 (org-persist-collection-let collection 664 (when (or path (cadr c)) 665 (when (cadr c) (setq path (cadr c))) 666 (let* ((persist-file (plist-get collection :persist-file)) 667 (ext (file-name-extension path)) 668 (file-copy (org-file-name-concat 669 org-persist-directory 670 (format "%s-%s.%s" persist-file (md5 path) ext)))) 671 (unless (file-exists-p file-copy) 672 (unless (file-exists-p (file-name-directory file-copy)) 673 (make-directory (file-name-directory file-copy) t)) 674 (if (org--should-fetch-remote-resource-p path) 675 (url-copy-file path file-copy 'overwrite) 676 (error "The remote resource %S is considered unsafe, and will not be downloaded." 677 path))) 678 (format "%s-%s.%s" persist-file (md5 path) ext))))) 679 680 (defun org-persist-write:index (container _) 681 "Write index CONTAINER." 682 (org-persist--get-collection container) 683 (unless (file-exists-p org-persist-directory) 684 (make-directory org-persist-directory)) 685 (unless (file-exists-p org-persist-directory) 686 (warn "Failed to create org-persist storage in %s." 687 org-persist-directory) 688 (let ((dir (directory-file-name 689 (file-name-as-directory org-persist-directory)))) 690 (while (and (not (file-exists-p dir)) 691 (not (equal dir (setq dir (directory-file-name 692 (file-name-directory dir))))))) 693 (unless (file-writable-p dir) 694 (message "Missing write access rights to org-persist-directory: %S" 695 org-persist-directory)))) 696 (when (file-exists-p org-persist-directory) 697 (org-persist--write-elisp-file 698 (org-file-name-concat org-persist-directory org-persist-index-file) 699 org-persist--index 700 t t) 701 (org-file-name-concat org-persist-directory org-persist-index-file))) 702 703 (defun org-persist--save-index () 704 "Save `org-persist--index." 705 (org-persist-write:index 706 `(index ,org-persist--storage-version) nil)) 707 708 ;;;; Public API 709 710 (cl-defun org-persist-register (container &optional associated &rest misc 711 &key inherit 712 &key (expiry org-persist-default-expiry) 713 &key (write-immediately nil) 714 &allow-other-keys) 715 "Register CONTAINER in ASSOCIATED to be persistent across Emacs sessions. 716 Optional key INHERIT makes CONTAINER dependent on another container. 717 Such dependency means that data shared between variables will be 718 preserved (see elisp#Circular Objects). 719 Optional key EXPIRY will set the expiry condition of the container. 720 It can be `never', nil - until end of session, a number of days since 721 last access, or a function accepting a single argument - collection. 722 EXPIRY key has no effect when INHERIT is non-nil. 723 Optional key WRITE-IMMEDIATELY controls whether to save the container 724 data immediately. 725 MISC will be appended to the collection. It must be alternating :KEY 726 VALUE pairs. 727 When WRITE-IMMEDIATELY is non-nil, the return value will be the same 728 with `org-persist-write'." 729 (unless org-persist--index (org-persist--load-index)) 730 (setq container (org-persist--normalize-container container)) 731 (when inherit 732 (setq inherit (org-persist--normalize-container inherit)) 733 (let ((inherited-collection (org-persist--get-collection inherit associated)) 734 new-collection) 735 (unless (member container (plist-get inherited-collection :container)) 736 (setq new-collection 737 (plist-put (copy-sequence inherited-collection) :container 738 (cons container (plist-get inherited-collection :container)))) 739 (org-persist--remove-from-index inherited-collection) 740 (org-persist--add-to-index new-collection)))) 741 (let ((collection (org-persist--get-collection container associated misc))) 742 (when (and expiry (not inherit)) 743 (when expiry (plist-put collection :expiry expiry)))) 744 (when (or (bufferp associated) (bufferp (plist-get associated :buffer))) 745 (with-current-buffer (if (bufferp associated) 746 associated 747 (plist-get associated :buffer)) 748 (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local))) 749 (when write-immediately (org-persist-write container associated))) 750 751 (defun org-persist-unregister (container &optional associated) 752 "Unregister CONTAINER in ASSOCIATED to be persistent. 753 When ASSOCIATED is `all', unregister CONTAINER everywhere." 754 (unless org-persist--index (org-persist--load-index)) 755 (setq container (org-persist--normalize-container container)) 756 (if (eq associated 'all) 757 (mapc (lambda (collection) 758 (when (member container (plist-get collection :container)) 759 (org-persist-unregister container (plist-get collection :associated)))) 760 org-persist--index) 761 (setq associated (org-persist--normalize-associated associated)) 762 (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) 763 (when collection 764 (if (= (length (plist-get collection :container)) 1) 765 (org-persist--remove-from-index collection) 766 (plist-put collection :container 767 (remove container (plist-get collection :container))) 768 (org-persist--add-to-index collection)))))) 769 770 (defvar org-persist--write-cache (make-hash-table :test #'equal) 771 "Hash table storing as-written data objects. 772 773 This data is used to avoid reading the data multiple times.") 774 (defun org-persist-read (container &optional associated hash-must-match load?) 775 "Restore CONTAINER data for ASSOCIATED. 776 When HASH-MUST-MATCH is non-nil, do not restore data if hash for 777 ASSOCIATED file or buffer does not match. 778 ASSOCIATED can be a plist, a buffer, or a string. 779 A buffer is treated as (:buffer ASSOCIATED). 780 A string is treated as (:file ASSOCIATED). 781 When LOAD? is non-nil, load the data instead of reading." 782 (unless org-persist--index (org-persist--load-index)) 783 (setq associated (org-persist--normalize-associated associated)) 784 (setq container (org-persist--normalize-container container)) 785 (let* ((collection (org-persist--find-index `(:container ,container :associated ,associated))) 786 (persist-file 787 (when collection 788 (org-file-name-concat 789 org-persist-directory 790 (plist-get collection :persist-file)))) 791 (data nil)) 792 (when (and collection 793 (file-exists-p persist-file) 794 (or (not (plist-get collection :expiry)) ; current session 795 (not (org-persist--gc-expired-p 796 (plist-get collection :expiry) collection))) 797 (or (not hash-must-match) 798 (and (plist-get associated :hash) 799 (equal (plist-get associated :hash) 800 (plist-get (plist-get collection :associated) :hash))))) 801 (unless (seq-find (lambda (v) 802 (run-hook-with-args-until-success 'org-persist-before-read-hook v associated)) 803 (plist-get collection :container)) 804 (setq data (or (gethash persist-file org-persist--write-cache) 805 (org-persist--read-elisp-file persist-file))) 806 (when data 807 (cl-loop for container in (plist-get collection :container) 808 with result = nil 809 do 810 (if load? 811 (push (org-persist-load:generic container (alist-get container data nil nil #'equal) collection) result) 812 (push (org-persist-read:generic container (alist-get container data nil nil #'equal) collection) result)) 813 (run-hook-with-args 'org-persist-after-read-hook container associated) 814 finally return (if (= 1 (length result)) (car result) result))))))) 815 816 (defun org-persist-load (container &optional associated hash-must-match) 817 "Load CONTAINER data for ASSOCIATED. 818 The arguments have the same meaning as in `org-persist-read'." 819 (org-persist-read container associated hash-must-match t)) 820 821 (defun org-persist-load-all (&optional associated) 822 "Restore all the persistent data associated with ASSOCIATED." 823 (unless org-persist--index (org-persist--load-index)) 824 (setq associated (org-persist--normalize-associated associated)) 825 (let (all-containers) 826 (dolist (collection org-persist--index) 827 (when collection 828 (cl-pushnew (plist-get collection :container) all-containers :test #'equal))) 829 (dolist (container all-containers) 830 (condition-case err 831 (org-persist-load container associated t) 832 (error 833 (message "%s. Deleting bad index entry." err) 834 (org-persist--remove-from-index (org-persist--find-index `(:container ,container :associated ,associated))) 835 nil))))) 836 837 (defun org-persist-load-all-buffer () 838 "Call `org-persist-load-all' in current buffer." 839 (org-persist-load-all (current-buffer))) 840 841 (defun org-persist-write (container &optional associated ignore-return) 842 "Save CONTAINER according to ASSOCIATED. 843 ASSOCIATED can be a plist, a buffer, or a string. 844 A buffer is treated as (:buffer ASSOCIATED). 845 A string is treated as (:file ASSOCIATED). 846 The return value is nil when writing fails and the written value (as 847 returned by `org-persist-read') on success. 848 When IGNORE-RETURN is non-nil, just return t on success without calling 849 `org-persist-read'." 850 (setq associated (org-persist--normalize-associated associated)) 851 ;; Update hash 852 (when (and (plist-get associated :file) 853 (plist-get associated :hash) 854 (get-file-buffer (plist-get associated :file))) 855 (setq associated (org-persist--normalize-associated (get-file-buffer (plist-get associated :file))))) 856 (let ((collection (org-persist--get-collection container associated))) 857 (setf collection (plist-put collection :associated associated)) 858 (unless (or 859 ;; Prevent data leakage from encrypted files. 860 ;; We do it in somewhat paranoid manner and do not 861 ;; allow anything related to encrypted files to be 862 ;; written. 863 (and (plist-get associated :file) 864 (string-match-p epa-file-name-regexp (plist-get associated :file))) 865 (seq-find (lambda (v) 866 (run-hook-with-args-until-success 'org-persist-before-write-hook v associated)) 867 (plist-get collection :container))) 868 (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) 869 (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) 870 (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) 871 (plist-get collection :container)))) 872 (puthash file data org-persist--write-cache) 873 (org-persist--write-elisp-file file data) 874 (or ignore-return (org-persist-read container associated))))))) 875 876 (defun org-persist-write-all (&optional associated) 877 "Save all the persistent data. 878 When ASSOCIATED is non-nil, only save the matching data." 879 (unless org-persist--index (org-persist--load-index)) 880 (setq associated (org-persist--normalize-associated associated)) 881 (if 882 (and (equal 1 (length org-persist--index)) 883 ;; The single collection only contains a single container 884 ;; in the container list. 885 (equal 1 (length (plist-get (car org-persist--index) :container))) 886 ;; The container is an `index' container. 887 (eq 'index (caar (plist-get (car org-persist--index) :container))) 888 (or (not (file-exists-p org-persist-directory)) 889 (org-directory-empty-p org-persist-directory))) 890 ;; Do not write anything, and clear up `org-persist-directory' to reduce 891 ;; clutter. 892 (when (and (file-exists-p org-persist-directory) 893 (org-directory-empty-p org-persist-directory)) 894 (delete-directory org-persist-directory)) 895 ;; Write the data. 896 (let (all-containers) 897 (dolist (collection org-persist--index) 898 (if associated 899 (when collection 900 (cl-pushnew (plist-get collection :container) all-containers :test #'equal)) 901 (condition-case err 902 (org-persist-write (plist-get collection :container) (plist-get collection :associated) t) 903 (error 904 (message "%s. Deleting bad index entry." err) 905 (org-persist--remove-from-index collection) 906 nil)))) 907 (dolist (container all-containers) 908 (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) 909 (when collection 910 (condition-case err 911 (org-persist-write container associated t) 912 (error 913 (message "%s. Deleting bad index entry." err) 914 (org-persist--remove-from-index collection) 915 nil)))))))) 916 917 (defun org-persist-write-all-buffer () 918 "Call `org-persist-write-all' in current buffer. 919 Do nothing in an indirect buffer." 920 (unless (buffer-base-buffer (current-buffer)) 921 (org-persist-write-all (current-buffer)))) 922 923 (defalias 'org-persist-gc:elisp #'ignore) 924 (defalias 'org-persist-gc:index #'ignore) 925 926 (defun org-persist-gc:file (container collection) 927 "Garbage collect file CONTAINER in COLLECTION." 928 (let ((file (org-persist-read container (plist-get collection :associated)))) 929 (when (file-exists-p file) 930 (delete-file file)))) 931 932 (defun org-persist-gc:url (container collection) 933 "Garbage collect url CONTAINER in COLLECTION." 934 (let ((file (org-persist-read container (plist-get collection :associated)))) 935 (when (file-exists-p file) 936 (delete-file file)))) 937 938 (defmacro org-persist--gc-persist-file (persist-file) 939 "Garbage collect PERSIST-FILE." 940 `(when (file-exists-p ,persist-file) 941 (delete-file ,persist-file) 942 (when (org-directory-empty-p (file-name-directory ,persist-file)) 943 (delete-directory (file-name-directory ,persist-file))))) 944 945 (defun org-persist-gc () 946 "Remove expired or unregistered containers. 947 Also, remove containers associated with non-existing files." 948 (let (new-index (remote-files-num 0)) 949 (dolist (collection org-persist--index) 950 (let* ((file (plist-get (plist-get collection :associated) :file)) 951 (file-remote (when file (file-remote-p file))) 952 (persist-file (when (plist-get collection :persist-file) 953 (org-file-name-concat 954 org-persist-directory 955 (plist-get collection :persist-file)))) 956 (expired? (org-persist--gc-expired-p 957 (plist-get collection :expiry) collection))) 958 (when persist-file 959 (when file 960 (when file-remote (cl-incf remote-files-num)) 961 (unless (if (not file-remote) 962 (file-exists-p file) 963 (pcase org-persist-remote-files 964 ('t t) 965 ('check-existence 966 (file-exists-p file)) 967 ((pred numberp) 968 (<= org-persist-remote-files remote-files-num)) 969 (_ nil))) 970 (setq expired? t))) 971 (if expired? 972 (org-persist--gc-persist-file persist-file) 973 (push collection new-index))))) 974 (setq org-persist--index (nreverse new-index)))) 975 976 (defun org-persist-clear-storage-maybe () 977 "Clear `org-persist-directory' according to `org-persist--disable-when-emacs-Q'. 978 979 When `org-persist--disable-when-emacs-Q' is non-nil and Emacs is called with -Q 980 command line argument, `org-persist-directory' is created in potentially public 981 system temporary directory. Remove everything upon existing Emacs in 982 such scenario." 983 (when (and org-persist--disable-when-emacs-Q 984 ;; FIXME: This is relying on undocumented fact that 985 ;; Emacs sets `user-init-file' to nil when loaded with 986 ;; "-Q" argument. 987 (not user-init-file) 988 (file-exists-p org-persist-directory)) 989 (delete-directory org-persist-directory 'recursive))) 990 991 ;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set. 992 (when (and org-persist--disable-when-emacs-Q 993 ;; FIXME: This is relying on undocumented fact that 994 ;; Emacs sets `user-init-file' to nil when loaded with 995 ;; "-Q" argument. 996 (not user-init-file)) 997 (setq org-persist-directory 998 (make-temp-file "org-persist-" 'dir))) 999 1000 ;; Automatically write the data, but only when we have write access. 1001 (let ((dir (directory-file-name 1002 (file-name-as-directory org-persist-directory)))) 1003 (while (and (not (file-exists-p dir)) 1004 (not (equal dir (setq dir (directory-file-name 1005 (file-name-directory dir))))))) 1006 (if (not (file-writable-p dir)) 1007 (message "Missing write access rights to org-persist-directory: %S" 1008 org-persist-directory) 1009 (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. 1010 (add-hook 'kill-emacs-hook #'org-persist-write-all) 1011 ;; `org-persist-gc' should run before `org-persist-write-all'. 1012 ;; So we are adding the hook after `org-persist-write-all'. 1013 (add-hook 'kill-emacs-hook #'org-persist-gc))) 1014 1015 (add-hook 'after-init-hook #'org-persist-load-all) 1016 1017 (provide 'org-persist) 1018 1019 ;;; org-persist.el ends here