org-persist.el (61480B)
1 ;;; org-persist.el --- Persist cached data across Emacs sessions -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; Author: Ihor Radchenko <yantar92 at posteo dot net> 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 ;; Entry points are `org-persist-register', `org-persist-write', 31 ;; `org-persist-read', and `org-persist-load'. 32 ;; 33 ;; `org-persist-register' will mark the data to be stored. By 34 ;; default, the data is written on disk before exiting Emacs session. 35 ;; Optionally, the data can be written immediately. 36 ;; 37 ;; `org-persist-write' will immediately write the data onto disk. 38 ;; 39 ;; `org-persist-read' will read the data and return its value or list 40 ;; of values for each requested container. 41 ;; 42 ;; `org-persist-load' will read the data with side effects. For 43 ;; example, loading `elisp' container will assign the values to 44 ;; variables. 45 ;; 46 ;; Example usage: 47 ;; 48 ;; 1. Temporarily cache Elisp symbol value to disk. Remove upon 49 ;; closing Emacs: 50 ;; (org-persist-write 'variable-symbol) 51 ;; (org-persist-read 'variable-symbol) ;; read the data later 52 ;; 53 ;; 2. Temporarily cache a remote URL file to disk. Remove upon 54 ;; closing Emacs: 55 ;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png") 56 ;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png") 57 ;; `org-persist-read' will return the cached file location or nil if cached file 58 ;; has been removed. 59 ;; 60 ;; 3. Temporarily cache a file, including TRAMP path to disk: 61 ;; (org-persist-write 'file "/path/to/file") 62 ;; 63 ;; 4. Cache file or URL while some other file exists. 64 ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file") :expiry 'never :write-immediately t) 65 ;; or, if the other file is current buffer file 66 ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") (current-buffer) :expiry 'never :write-immediately t) 67 ;; 68 ;; 5. Cache value of a Elisp variable to disk. The value will be 69 ;; saved and restored automatically (except buffer-local 70 ;; variables). 71 ;; ;; Until `org-persist-default-expiry' 72 ;; (org-persist-register 'variable-symbol) 73 ;; ;; Specify expiry explicitly 74 ;; (org-persist-register 'variable-symbol :expiry 'never) 75 ;; ;; Save buffer-local variable (buffer-local will not be 76 ;; ;; autoloaded!) 77 ;; (org-persist-register 'org-element--cache (current-buffer)) 78 ;; ;; Save several buffer-local variables preserving circular links 79 ;; ;; between: 80 ;; (org-persist-register 'org-element--headline-cache (current-buffer) 81 ;; :inherit 'org-element--cache) 82 ;; 83 ;; 6. Load variable by side effects assigning variable symbol: 84 ;; (org-persist-load 'variable-symbol (current-buffer)) 85 ;; 86 ;; 7. Version variable value: 87 ;; (org-persist-register '((elisp variable-symbol) (version "2.0"))) 88 ;; 89 ;; 8. Define a named container group: 90 ;; 91 ;; (let ((info1 "test") 92 ;; (info2 "test 2")) 93 ;; (org-persist-register 94 ;; `("Named data" (elisp info1 local) (elisp info2 local)) 95 ;; nil :write-immediately t)) 96 ;; (org-persist-read 97 ;; "Named data" 98 ;; nil nil nil :read-related t) ; => ("Named data" "test" "test2") 99 ;; 100 ;; 9. Cancel variable persistence: 101 ;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers 102 ;; (org-persist-unregister 'variable-symbol) ;; global variable 103 ;; (org-persist-unregister 'variable-symbol (current-buffer)) ;; buffer-local 104 ;; 105 ;; Most common data type is variable data. However, other data types 106 ;; can also be stored. 107 ;; 108 ;; Persistent data is stored in individual files. Each of the files 109 ;; can contain a collection of related data, which is particularly 110 ;; useful when, say, several variables cross-reference each-other's 111 ;; data-cells and we want to preserve their circular structure. 112 ;; 113 ;; Each data collection can be associated with a local or remote file, 114 ;; its inode number, contents hash. The persistent data collection 115 ;; can later be accessed using either file buffer, file, inode, or 116 ;; contents hash. 117 ;; 118 ;; The data collections can be versioned and removed upon expiry. 119 ;; 120 ;; In the code below, I will use the following naming conventions: 121 ;; 122 ;; 1. Container :: a type of data to be stored 123 ;; Containers can store elisp variables, files, and version 124 ;; numbers. Each container can be customized with container 125 ;; options. For example, `elisp' container is customized with 126 ;; variable symbol. (elisp variable) is a container storing 127 ;; Lisp variable value. Similarly, (version "2.0") container 128 ;; will store version number. 129 ;; 130 ;; Container can also refer to a group of containers: 131 ;; 132 ;; ;; Three containers stored together. 133 ;; '((elisp variable) (file "/path") (version "x.x")) 134 ;; 135 ;; Providing a single container from the list to `org-persist-read' 136 ;; is sufficient to retrieve all the containers (with appropriate 137 ;; optional parameter). 138 ;; 139 ;; Example: 140 ;; 141 ;; (org-persist-register '((version "My data") (file "/path/to/file")) '(:key "key") :write-immediately t) 142 ;; (org-persist-read '(version "My data") '(:key "key") :read-related t) ;; => '("My data" "/path/to/file/copy") 143 ;; 144 ;; Individual containers can also take a short form (not a list): 145 ;; 146 ;; '("String" file '(quoted elisp "value") :keyword) 147 ;; is the same with 148 ;; '((elisp-data "String") (file nil) 149 ;; (elisp-data '(quoted elisp "value")) (elisp-data :keyword)) 150 ;; 151 ;; Note that '(file "String" (elisp value)) would be interpreted as 152 ;; `file' container with "String" path and extra options. See 153 ;; `org-persist--normalize-container'. 154 ;; 155 ;; 2. Associated :: an object the container is associated with. The 156 ;; object can be a buffer, file, inode number, file contents hash, 157 ;; a generic key, or multiple of them. Associated can also be nil. 158 ;; 159 ;; Example: 160 ;; 161 ;; '(:file "/path/to/file" :inode number :hash buffer-hash :key arbitrary-key) 162 ;; 163 ;; When several objects are associated with a single container, it 164 ;; is not necessary to provide them all to access the container. 165 ;; Just using a single :file/:inode/:hash/:key is sufficient. This 166 ;; way, one can retrieve cached data even when the file has moved - 167 ;; by contents hash. 168 ;; 169 ;; 3. Data collection :: a list of containers, the associated 170 ;; object/objects, expiry, access time, and information about where 171 ;; the cache is stored. Each data collection can also have 172 ;; auxiliary records. Their only purpose is readability of the 173 ;; collection index. 174 ;; 175 ;; Example: 176 ;; 177 ;; (:container 178 ;; ((index "2.7")) 179 ;; :persist-file "ba/cef3b7-e31c-4791-813e-8bd0bf6c5f9c" 180 ;; :associated nil :expiry never 181 ;; :last-access 1672207741.6422956 :last-access-hr "2022-12-28T09:09:01+0300") 182 ;; 183 ;; 4. Index file :: a file listing all the stored data collections. 184 ;; 185 ;; 5. Persist file :: a file holding data values or references to 186 ;; actual data values for a single data collection. This file 187 ;; contains an alist associating each data container in data 188 ;; collection with its value or a reference to the actual value. 189 ;; 190 ;; Example (persist file storing two elisp container values): 191 ;; 192 ;; (((elisp org-element--headline-cache) . #s(avl-tree- ...)) 193 ;; ((elisp org-element--cache) . #s(avl-tree- ...))) 194 ;; 195 ;; All the persistent data is stored in `org-persist-directory'. The data 196 ;; collections are listed in `org-persist-index-file' and the actual data is 197 ;; stored in UID-style subfolders. 198 ;; 199 ;; The `org-persist-index-file' stores the value of `org-persist--index'. 200 ;; 201 ;; Each collection is represented as a plist containing the following 202 ;; properties: 203 ;; 204 ;; - `:container' : list of data containers to be stored in single 205 ;; file; 206 ;; - `:persist-file': data file name; 207 ;; - `:associated' : list of associated objects; 208 ;; - `:last-access' : last date when the container has been accessed; 209 ;; - `:expiry' : list of expiry conditions. 210 ;; - all other keywords are ignored 211 ;; 212 ;; The available types of data containers are: 213 ;; 1. (elisp variable-symbol scope) or just variable-symbol :: Storing 214 ;; elisp variable data. SCOPE can be 215 ;; 216 ;; - `nil' :: Use buffer-local value in associated :file or global 217 ;; value if no :file is associated. 218 ;; - string :: Use buffer-local value in buffer named STRING or 219 ;; with STRING `buffer-file-name'. 220 ;; - `local' :: Use symbol value in current scope. 221 ;; Note: If `local' scope is used without writing the 222 ;; value immediately, the actual stored value is 223 ;; undefined. 224 ;; 225 ;; 2. (file) :: Store a copy of the associated file preserving the 226 ;; extension. 227 228 ;; (file "/path/to/a/file") :: Store a copy of the file in path. 229 ;; 230 ;; 3. (version "version number") :: Version the data collection. 231 ;; If the stored collection has different version than "version 232 ;; number", disregard it. 233 ;; 234 ;; 4. (url) :: Store a downloaded copy of URL object given by 235 ;; associated :file. 236 ;; (url "path") :: Use "path" instead of associated :file. 237 ;; 238 ;; The data collections can expire, in which case they will be removed 239 ;; from the persistent storage at the end of Emacs session. The 240 ;; expiry condition can be set when saving/registering data 241 ;; containers. The expirty condition can be `never' - data will never 242 ;; expire; nil - data will expire at the end of current Emacs session; 243 ;; a number - data will expire after the number days from last access; 244 ;; a function - data will expire if the function, called with a single 245 ;; argument - collection, returns non-nil. 246 ;; 247 ;; 248 ;; Data collections associated with files will automatically expire 249 ;; when the file is removed. If the associated file is remote, the 250 ;; expiry is controlled by `org-persist-remote-files' instead. 251 ;; 252 ;; Data loading/writing can be more accurately controlled using 253 ;; `org-persist-before-write-hook', `org-persist-before-read-hook', 254 ;; and `org-persist-after-read-hook'. 255 256 ;;; Code: 257 258 (require 'org-macs) 259 (org-assert-version) 260 261 (require 'org-compat) 262 (require 'org-id) 263 (require 'xdg nil t) 264 265 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 266 (declare-function org-next-visible-heading "org" (arg)) 267 (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) 268 269 ;; Silence byte-compiler (used in `org-persist--write-elisp-file'). 270 (defvar pp-use-max-width) 271 272 (defconst org-persist--storage-version "3.2" 273 "Persistent storage layout version.") 274 275 (defgroup org-persist nil 276 "Persistent cache for Org mode." 277 :tag "Org persist" 278 :group 'org) 279 280 (defcustom org-persist-directory 281 (expand-file-name 282 (org-file-name-concat 283 (let ((cache-dir (when (fboundp 'xdg-cache-home) 284 (xdg-cache-home)))) 285 (if (or (seq-empty-p cache-dir) 286 (not (file-exists-p cache-dir)) 287 (file-exists-p (org-file-name-concat 288 user-emacs-directory 289 "org-persist"))) 290 user-emacs-directory 291 cache-dir)) 292 "org-persist/")) 293 "Directory where the data is stored." 294 :group 'org-persist 295 :package-version '(Org . "9.6") 296 :type 'directory) 297 298 (defcustom org-persist-remote-files 100 299 "Whether to keep persistent data for remote files. 300 301 When this variable is nil, never save persistent data associated with 302 remote files. When t, always keep the data. When 303 `check-existence', contact remote server containing the file and only 304 keep the data when the file exists on the server. When a number, keep 305 up to that number persistent values for remote files. 306 307 Note that the last option `check-existence' may cause Emacs to show 308 password prompts to log in." 309 :group 'org-persist 310 :package-version '(Org . "9.6") 311 :type '(choice (const :tag "Never" nil) 312 (const :tag "Always" t) 313 (number :tag "Keep not more than X files") 314 (const :tag "Check if exist on remote" check-existence))) 315 316 (defcustom org-persist-default-expiry 30 317 "Default expiry condition for persistent data. 318 319 When this variable is nil, all the data vanishes at the end of Emacs 320 session. When `never', the data never vanishes. When a number, the 321 data is deleted that number days after last access. When a function, 322 it should be a function returning non-nil when the data is expired. The 323 function will be called with a single argument - collection." 324 :group 'org-persist 325 :package-version '(Org . "9.6") 326 :type '(choice (const :tag "Never" never) 327 (const :tag "Always" nil) 328 (number :tag "Keep N days") 329 (function :tag "Function"))) 330 331 (defconst org-persist-index-file "index.eld" 332 "File name used to store the data index.") 333 334 (defconst org-persist-gc-lock-file "gc-lock.eld" 335 "File used to store information about active Emacs sessions. 336 The file contains an alist of (`before-init-time' . LAST-ACTIVE-TIME). 337 `before-init-time' uniquely identifies Emacs process and 338 LAST-ACTIVE-TIME is written every `org-persist-gc-lock-interval' 339 seconds. When LAST-ACTIVE-TIME is more than 340 `org-persist-gc-lock-expiry' seconds ago, that Emacs session is 341 considered not active.") 342 343 (defvar org-persist-gc-lock-interval (* 60 60) ; 1 hour 344 "Interval in seconds for refreshing `org-persist-gc-lock-file'.") 345 346 (defvar org-persist-gc-lock-expiry (* 60 60 24) ; 1 day 347 "Interval in seconds for expiring a record in `org-persist-gc-lock-file'.") 348 349 (defvar org-persist--disable-when-emacs-Q t 350 "Disable persistence when Emacs is called with -Q command line arg. 351 When non-nil, this sets `org-persist-directory' to temporary directory. 352 353 This variable must be set before loading org-persist library.") 354 355 (defvar org-persist-before-write-hook nil 356 "Abnormal hook ran before saving data. 357 The hook must accept the same arguments as `org-persist-write'. 358 The hooks will be evaluated until a hook returns non-nil. 359 If any of the hooks return non-nil, do not save the data.") 360 361 (defvar org-persist-before-read-hook nil 362 "Abnormal hook ran before reading data. 363 The hook must accept the same arguments as `org-persist-read'. 364 The hooks will be evaluated until a hook returns non-nil. 365 If any of the hooks return non-nil, do not read the data.") 366 367 (defvar org-persist-after-read-hook nil 368 "Abnormal hook ran after reading data. 369 The hook must accept the same arguments as `org-persist-read'.") 370 371 (defvar org-persist--index nil 372 "Global index. 373 374 The index is a list of plists. Each plist contains information about 375 persistent data storage. Each plist contains the following 376 properties: 377 378 - `:container' : list of data containers to be stored in single file 379 - `:persist-file': data file name 380 - `:associated' : list of associated objects 381 - `:last-access' : last date when the container has been read 382 - `:expiry' : list of expiry conditions 383 - all other keywords are ignored.") 384 385 (defvar org-persist--index-hash nil 386 "Hash table storing `org-persist--index'. Used for quick access. 387 The keys are conses of (container . associated).") 388 389 (defvar org-persist--index-age nil 390 "The modification time of the index file, when it was loaded.") 391 392 (defvar org-persist--report-time nil 393 "Whether to report read/write time. 394 395 When the value is a number, it is a threshold number of seconds. If 396 the read/write time of a single persist file exceeds the threshold, a 397 message is displayed. 398 399 When the value is a non-nil non-number, always display the message. 400 When the value is nil, never display the message.") 401 402 ;;;; Common functions 403 404 (defun org-persist--display-time (duration format &rest args) 405 "Report DURATION according to FORMAT + ARGS message. 406 FORMAT and ARGS are passed to `message'." 407 (when (or (and org-persist--report-time 408 (numberp org-persist--report-time) 409 (>= duration org-persist--report-time)) 410 (and org-persist--report-time 411 (not (numberp org-persist--report-time)))) 412 (apply #'message 413 (format "org-persist: %s took %%.2f sec" format) 414 (append args (list duration))))) 415 416 (defun org-persist--read-elisp-file (&optional buffer-or-file) 417 "Read elisp data from BUFFER-OR-FILE or current buffer." 418 (let (;; UTF-8 is explicitly used in `org-persist--write-elisp-file'. 419 (coding-system-for-read 'emacs-internal) 420 (buffer-or-file (or buffer-or-file (current-buffer)))) 421 (with-temp-buffer 422 (if (bufferp buffer-or-file) 423 (set-buffer buffer-or-file) 424 (insert-file-contents buffer-or-file)) 425 (condition-case err 426 (let ((read-circle t) 427 (start-time (float-time))) 428 ;; FIXME: Reading sometimes fails to read circular objects. 429 ;; I suspect that it happens when we have object reference 430 ;; #N# read before object definition #N=. If it is really 431 ;; so, it should be Emacs bug - either in `read' or in 432 ;; `prin1'. Meanwhile, just fail silently when `read' 433 ;; fails to parse the saved cache object. 434 (prog1 435 (read (current-buffer)) 436 (org-persist--display-time 437 (- (float-time) start-time) 438 "Reading from %S" buffer-or-file))) 439 ;; Recover gracefully if index file is corrupted. 440 (error 441 ;; Remove problematic file. 442 (unless (bufferp buffer-or-file) (delete-file buffer-or-file)) 443 ;; Do not report the known error to user. 444 (if (string-match-p "Invalid read syntax" (error-message-string err)) 445 (message "Emacs reader failed to read data in %S. The error was: %S" 446 buffer-or-file (error-message-string err)) 447 (warn "Emacs reader failed to read data in %S. The error was: %S" 448 buffer-or-file (error-message-string err))) 449 nil))))) 450 451 ;; FIXME: `pp' is very slow when writing even moderately large datasets 452 ;; We should probably drop it or find some fast formatter. 453 (defun org-persist--write-elisp-file (file data &optional no-circular pp) 454 "Write elisp DATA to FILE." 455 ;; Fsync slightly reduces the chance of an incomplete filesystem 456 ;; write, however on modern hardware its effectiveness is 457 ;; questionable and it is insufficient to guarantee complete writes. 458 ;; Coupled with the significant performance hit if writing many 459 ;; small files, it simply does not make sense to use fsync here, 460 ;; particularly as cache corruption is only a minor inconvenience. 461 ;; With all this in mind, we ensure `write-region-inhibit-fsync' is 462 ;; set. 463 ;; 464 ;; To read more about this, see the comments in Emacs's fileio.c, in 465 ;; particular the large comment block in init_fileio. 466 (let ((write-region-inhibit-fsync t) 467 ;; We set UTF-8 here and in `org-persist--read-elisp-file' 468 ;; to avoid the overhead from `find-auto-coding'. 469 (coding-system-for-write 'emacs-internal) 470 (print-circle (not no-circular)) 471 print-level 472 print-length 473 print-quoted 474 (print-escape-control-characters t) 475 (print-escape-nonascii t) 476 (print-continuous-numbering t) 477 print-number-table 478 (start-time (float-time))) 479 (unless (file-exists-p (file-name-directory file)) 480 (make-directory (file-name-directory file) t)) 481 ;; Force writing even when the file happens to be opened by 482 ;; another Emacs process. 483 (cl-letf (((symbol-function #'ask-user-about-lock) 484 ;; FIXME: Emacs 27 does not yet have `always'. 485 (lambda (&rest _) t))) 486 (with-temp-file file 487 (insert ";; -*- mode: lisp-data; -*-\n") 488 (if pp 489 (let ((pp-use-max-width nil)) ; Emacs bug#58687 490 (pp data (current-buffer))) 491 (prin1 data (current-buffer))))) 492 (org-persist--display-time 493 (- (float-time) start-time) 494 "Writing to %S" file))) 495 496 (defmacro org-persist-gc:generic (container collection) 497 "Garbage collect CONTAINER data from COLLECTION." 498 `(let* ((c (org-persist--normalize-container ,container)) 499 (gc-func-symbol (intern (format "org-persist-gc:%s" (car c))))) 500 (unless (fboundp gc-func-symbol) 501 (error "org-persist: GC function %s not defined" 502 gc-func-symbol)) 503 (funcall gc-func-symbol c ,collection))) 504 505 (defmacro org-persist--gc-expired-p (cnd collection) 506 "Check if expiry condition CND triggers for COLLECTION." 507 `(pcase ,cnd 508 (`nil t) 509 (`never nil) 510 ((pred numberp) 511 (when (plist-get ,collection :last-access) 512 (> (float-time) (+ (plist-get ,collection :last-access) (* ,cnd 24 60 60))))) 513 ((pred functionp) 514 (funcall ,cnd ,collection)) 515 (_ (error "org-persist: Unsupported expiry type %S" ,cnd)))) 516 517 ;;;; Working with index 518 519 (defmacro org-persist-collection-let (collection &rest body) 520 "Bind container and associated from COLLECTION and execute BODY." 521 (declare (debug (form body)) (indent 1)) 522 `(with-no-warnings 523 (let* ((container (plist-get ,collection :container)) 524 (associated (plist-get ,collection :associated)) 525 (path (plist-get associated :file)) 526 (inode (plist-get associated :inode)) 527 (hash (plist-get associated :hash)) 528 (key (plist-get associated :key))) 529 ;; Suppress "unused variable" warnings. 530 (ignore container associated path inode hash key) 531 ,@body))) 532 533 (defun org-persist--find-index (collection) 534 "Find COLLECTION in `org-persist--index'." 535 (org-persist-collection-let collection 536 (and org-persist--index-hash 537 (catch :found 538 (dolist (cont (cons container container)) 539 (let (r) 540 (setq r (or (gethash (cons cont associated) org-persist--index-hash) 541 (and path (gethash (cons cont (list :file path)) org-persist--index-hash)) 542 (and inode (gethash (cons cont (list :inode inode)) org-persist--index-hash)) 543 (and hash (gethash (cons cont (list :hash hash)) org-persist--index-hash)) 544 (and key (gethash (cons cont (list :key key)) org-persist--index-hash)))) 545 (when r (throw :found r)))))))) 546 547 (defun org-persist--add-to-index (collection &optional hash-only) 548 "Add or update COLLECTION in `org-persist--index'. 549 When optional HASH-ONLY is non-nil, only modify the hash table. 550 Return PLIST." 551 (org-persist-collection-let collection 552 (let ((existing (org-persist--find-index collection))) 553 (if existing 554 (progn 555 (plist-put existing :container container) 556 (plist-put (plist-get existing :associated) :file path) 557 (plist-put (plist-get existing :associated) :inode inode) 558 (plist-put (plist-get existing :associated) :hash hash) 559 (plist-put (plist-get existing :associated) :key key) 560 existing) 561 (unless hash-only (push collection org-persist--index)) 562 (unless org-persist--index-hash (setq org-persist--index-hash (make-hash-table :test 'equal))) 563 (dolist (cont (cons container container)) 564 (puthash (cons cont associated) collection org-persist--index-hash) 565 (when path (puthash (cons cont (list :file path)) collection org-persist--index-hash)) 566 (when inode (puthash (cons cont (list :inode inode)) collection org-persist--index-hash)) 567 (when hash (puthash (cons cont (list :hash inode)) collection org-persist--index-hash)) 568 (when key (puthash (cons cont (list :key inode)) collection org-persist--index-hash))) 569 collection)))) 570 571 (defun org-persist--remove-from-index (collection) 572 "Remove COLLECTION from `org-persist--index'." 573 (let ((existing (org-persist--find-index collection))) 574 (when existing 575 (org-persist-collection-let collection 576 (dolist (cont (cons container container)) 577 (unless (listp (car container)) 578 (org-persist-gc:generic cont collection) 579 (dolist (afile (org-persist-associated-files:generic cont collection)) 580 (delete-file afile))) 581 (remhash (cons cont associated) org-persist--index-hash) 582 (when path (remhash (cons cont (list :file path)) org-persist--index-hash)) 583 (when inode (remhash (cons cont (list :inode inode)) org-persist--index-hash)) 584 (when hash (remhash (cons cont (list :hash hash)) org-persist--index-hash)) 585 (when key (remhash (cons cont (list :key key)) org-persist--index-hash)))) 586 (setq org-persist--index (delq existing org-persist--index))))) 587 588 (defun org-persist--get-collection (container &optional associated misc) 589 "Return or create collection used to store CONTAINER for ASSOCIATED. 590 When ASSOCIATED is nil, it is a global CONTAINER. 591 ASSOCIATED can also be a (:buffer buffer) or buffer, (:file file-path) 592 or file-path, (:inode inode), (:hash hash), or or (:key key). 593 MISC, if non-nil will be appended to the collection. It must be a plist." 594 (unless (and (listp container) (listp (car container))) 595 (setq container (list container))) 596 (setq associated (org-persist--normalize-associated associated)) 597 (when (and misc (or (not (listp misc)) (= 1 (% (length misc) 2)))) 598 (error "org-persist: Not a plist: %S" misc)) 599 (or (org-persist--find-index 600 `( :container ,(org-persist--normalize-container container) 601 :associated ,associated)) 602 (org-persist--add-to-index 603 (nconc 604 (list :container (org-persist--normalize-container container) 605 :persist-file 606 (replace-regexp-in-string "^.." "\\&/" (org-id-uuid)) 607 :associated associated) 608 misc)))) 609 610 ;;;; Reading container data. 611 612 (defun org-persist--normalize-container (container &optional inner) 613 "Normalize CONTAINER representation into (type . settings). 614 615 When INNER is non-nil, do not try to match as list of containers." 616 (pcase container 617 ((or `elisp `elisp-data `version `file `index `url) 618 `(,container nil)) 619 ((or (pred keywordp) (pred stringp) `(quote . ,_)) 620 `(elisp-data ,container)) 621 ((pred symbolp) 622 `(elisp ,container)) 623 (`(,(or `elisp `elisp-data `version `file `index `url) . ,_) 624 container) 625 ((and (pred listp) (guard (not inner))) 626 (mapcar (lambda (c) (org-persist--normalize-container c 'inner)) container)) 627 (_ (error "org-persist: Unknown container type: %S" container)))) 628 629 (defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key) 630 "Buffer hash cache.") 631 632 (defun org-persist--normalize-associated (associated) 633 "Normalize ASSOCIATED representation into (:type value)." 634 (pcase associated 635 ((or (pred stringp) `(:file ,_)) 636 (unless (stringp associated) 637 (setq associated (cadr associated))) 638 (let* ((rtn `(:file ,associated)) 639 (inode (and 640 ;; Do not store :inode for remote files - it may 641 ;; be time-consuming on slow connections or even 642 ;; fail completely when ssh connection is closed. 643 (not (file-remote-p associated)) 644 (fboundp 'file-attribute-inode-number) 645 (file-attribute-inode-number 646 (file-attributes associated))))) 647 (when inode (plist-put rtn :inode inode)) 648 rtn)) 649 ((or (pred bufferp) `(:buffer ,_)) 650 (unless (bufferp associated) 651 (setq associated (cadr associated))) 652 (let ((cached (gethash associated org-persist--associated-buffer-cache)) 653 file inode hash) 654 (if (and cached (eq (buffer-modified-tick associated) 655 (car cached))) 656 (progn 657 (setq file (nth 1 cached) 658 inode (nth 2 cached) 659 hash (nth 3 cached))) 660 (setq file (buffer-file-name 661 (or (buffer-base-buffer associated) 662 associated))) 663 (setq inode (when (and file 664 ;; Do not store :inode for remote files - it may 665 ;; be time-consuming on slow connections or even 666 ;; fail completely when ssh connection is closed. 667 (not (file-remote-p file)) 668 (fboundp 'file-attribute-inode-number)) 669 (file-attribute-inode-number 670 (file-attributes file)))) 671 (setq hash 672 ;; `secure-hash' may trigger interactive dialog when it 673 ;; cannot determine the coding system automatically. 674 ;; Force coding system that works reliably for any text 675 ;; to avoid it. The hash will be consistent, as long 676 ;; as we use the same coding system. 677 (let ((coding-system-for-write 'emacs-internal)) 678 (secure-hash 'md5 associated))) 679 (puthash associated 680 (list (buffer-modified-tick associated) 681 file inode hash) 682 org-persist--associated-buffer-cache)) 683 (let ((rtn `(:hash ,hash))) 684 (when file (setq rtn (plist-put rtn :file file))) 685 (when inode (setq rtn (plist-put rtn :inode inode))) 686 rtn))) 687 ((pred listp) 688 associated) 689 (_ (error "Unknown associated object %S" associated)))) 690 691 (defmacro org-persist-read:generic (container reference-data collection) 692 "Read and return the data stored in CONTAINER. 693 REFERENCE-DATA is associated with CONTAINER in the persist file. 694 COLLECTION is the plist holding data collection." 695 `(let* ((c (org-persist--normalize-container ,container)) 696 (read-func-symbol (intern (format "org-persist-read:%s" (car c))))) 697 (setf ,collection (plist-put ,collection :last-access (float-time))) 698 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) 699 (unless (fboundp read-func-symbol) 700 (error "org-persist: Read function %s not defined" 701 read-func-symbol)) 702 (funcall read-func-symbol c ,reference-data ,collection))) 703 704 (defun org-persist-read:elisp (_ lisp-value __) 705 "Read elisp container and return LISP-VALUE." 706 lisp-value) 707 708 (defun org-persist-read:elisp-data (container _ __) 709 "Read elisp-data CONTAINER." 710 (cadr container)) 711 712 (defalias 'org-persist-read:version #'org-persist-read:elisp-data) 713 714 (defun org-persist-read:file (_ path __) 715 "Read file container from PATH." 716 (when (and path (file-exists-p (org-file-name-concat org-persist-directory path))) 717 (org-file-name-concat org-persist-directory path))) 718 719 (defun org-persist-read:url (_ path __) 720 "Read file container from PATH." 721 (when (and path (file-exists-p (org-file-name-concat org-persist-directory path))) 722 (org-file-name-concat org-persist-directory path))) 723 724 (defun org-persist-read:index (cont index-file _) 725 "Read index container CONT from INDEX-FILE." 726 (when (file-exists-p index-file) 727 (let ((index (org-persist--read-elisp-file index-file))) 728 (when index 729 (catch :found 730 (dolist (collection index) 731 (org-persist-collection-let collection 732 (when (and (not associated) 733 (pcase container 734 (`((index ,version)) 735 (equal version (cadr cont))) 736 (_ nil))) 737 (throw :found index))))))))) 738 739 ;;;; Applying container data for side effects. 740 741 (defmacro org-persist-load:generic (container reference-data collection) 742 "Load the data stored in CONTAINER for side effects. 743 REFERENCE-DATA is associated with CONTAINER in the persist file. 744 COLLECTION is the plist holding data collection." 745 `(let* ((container (org-persist--normalize-container ,container)) 746 (load-func-symbol (intern (format "org-persist-load:%s" (car container))))) 747 (setf ,collection (plist-put ,collection :last-access (float-time))) 748 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) 749 (unless (fboundp load-func-symbol) 750 (error "org-persist: Load function %s not defined" 751 load-func-symbol)) 752 (funcall load-func-symbol container ,reference-data ,collection))) 753 754 (defun org-persist-load:elisp (container lisp-value collection) 755 "Assign elisp CONTAINER in COLLECTION LISP-VALUE." 756 (let ((lisp-symbol (cadr container)) 757 (buffer (when (plist-get (plist-get collection :associated) :file) 758 (get-file-buffer (plist-get (plist-get collection :associated) :file))))) 759 (if buffer 760 (with-current-buffer buffer 761 (make-variable-buffer-local lisp-symbol) 762 (set lisp-symbol lisp-value)) 763 (set lisp-symbol lisp-value)))) 764 765 (defalias 'org-persist-load:elisp-data #'org-persist-read:elisp-data) 766 (defalias 'org-persist-load:version #'org-persist-read:version) 767 (defalias 'org-persist-load:file #'org-persist-read:file) 768 769 (defun org-persist-load:index (container index-file _) 770 "Load `org-persist--index' from INDEX-FILE according to CONTAINER." 771 (unless org-persist--index 772 (setq org-persist--index (org-persist-read:index container index-file nil) 773 org-persist--index-hash nil 774 org-persist--index-age (file-attribute-modification-time 775 (file-attributes index-file))) 776 (if org-persist--index 777 (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index) 778 (setq org-persist--index nil) 779 (when (file-exists-p org-persist-directory) 780 (dolist (file (directory-files org-persist-directory 'absolute 781 "\\`[^.][^.]")) 782 (if (file-directory-p file) 783 (delete-directory file t) 784 (delete-file file)))) 785 (plist-put (org-persist--get-collection container) :expiry 'never)))) 786 787 (defun org-persist--load-index () 788 "Load `org-persist--index'." 789 (org-persist-load:index 790 `(index ,org-persist--storage-version) 791 (org-file-name-concat org-persist-directory org-persist-index-file) 792 nil)) 793 794 ;;;; Writing container data 795 796 (defmacro org-persist-write:generic (container collection) 797 "Write CONTAINER in COLLECTION." 798 `(let* ((c (org-persist--normalize-container ,container)) 799 (write-func-symbol (intern (format "org-persist-write:%s" (car c))))) 800 (unless (plist-get ,collection :last-access) 801 (setf ,collection (plist-put ,collection :last-access (float-time))) 802 (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time))))) 803 (unless (fboundp write-func-symbol) 804 (error "org-persist: Write function %s not defined" 805 write-func-symbol)) 806 (funcall write-func-symbol c ,collection))) 807 808 (defun org-persist-write:elisp (container collection) 809 "Write elisp CONTAINER according to COLLECTION." 810 (let ((scope (nth 2 container))) 811 (pcase scope 812 ((pred stringp) 813 (when-let* ((buf (or (get-buffer scope) 814 (get-file-buffer scope)))) 815 ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. 816 ;; Not using it yet to keep backward compatibility. 817 (condition-case nil 818 (buffer-local-value (cadr container) buf) 819 (void-variable nil)))) 820 (`local 821 (when (boundp (cadr container)) 822 (symbol-value (cadr container)))) 823 (`nil 824 (if-let* ((buf (and (plist-get (plist-get collection :associated) :file) 825 (get-file-buffer (plist-get (plist-get collection :associated) :file))))) 826 ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. 827 ;; Not using it yet to keep backward compatibility. 828 (condition-case nil 829 (buffer-local-value (cadr container) buf) 830 (void-variable nil)) 831 (when (boundp (cadr container)) 832 (symbol-value (cadr container)))))))) 833 834 (defalias 'org-persist-write:elisp-data #'ignore) 835 (defalias 'org-persist-write:version #'ignore) 836 837 (defun org-persist-write:file (c collection) 838 "Write file container C according to COLLECTION." 839 (org-persist-collection-let collection 840 (when (or (and path (file-exists-p path)) 841 (and (stringp (cadr c)) (file-exists-p (cadr c)))) 842 (when (and (stringp (cadr c)) (file-exists-p (cadr c))) 843 (setq path (cadr c))) 844 (let* ((persist-file (plist-get collection :persist-file)) 845 (ext (file-name-extension path)) 846 (file-copy (org-file-name-concat 847 org-persist-directory 848 (format "%s-%s.%s" persist-file (md5 path) ext)))) 849 (unless (file-exists-p file-copy) 850 (unless (file-exists-p (file-name-directory file-copy)) 851 (make-directory (file-name-directory file-copy) t)) 852 (copy-file path file-copy 'overwrite)) 853 (format "%s-%s.%s" persist-file (md5 path) ext))))) 854 855 (defun org-persist-write:url (c collection) 856 "Write url container C according to COLLECTION." 857 (org-persist-collection-let collection 858 (when (or path (cadr c)) 859 (when (cadr c) (setq path (cadr c))) 860 (let* ((persist-file (plist-get collection :persist-file)) 861 (ext (file-name-extension path)) 862 (file-copy (org-file-name-concat 863 org-persist-directory 864 (format "%s-%s.%s" persist-file (md5 path) ext)))) 865 (unless (file-exists-p file-copy) 866 (unless (file-exists-p (file-name-directory file-copy)) 867 (make-directory (file-name-directory file-copy) t)) 868 (if (org--should-fetch-remote-resource-p path) 869 (url-copy-file path file-copy 'overwrite) 870 (error "The remote resource %S is considered unsafe, and will not be downloaded" 871 path))) 872 (format "%s-%s.%s" persist-file (md5 path) ext))))) 873 874 (defun org-persist--check-write-access (path) 875 "Check write access to all missing directories in PATH. 876 Show message and return nil if there is no write access. 877 Otherwise, return t." 878 (let* ((dir (directory-file-name (file-name-as-directory path))) 879 (prev dir)) 880 (while (and (not (file-exists-p dir)) 881 (setq prev dir) 882 (not (equal dir (setq dir (directory-file-name 883 (file-name-directory dir))))))) 884 (if (file-writable-p prev) t ; return t 885 (message "org-persist: Missing write access rights to: %S" prev) 886 ;; return nil 887 nil))) 888 889 (defun org-persist-write:index (container _) 890 "Write index CONTAINER." 891 (org-persist--get-collection container) 892 (unless (file-exists-p org-persist-directory) 893 (condition-case nil 894 (make-directory org-persist-directory 'parent) 895 (t 896 (warn "Failed to create org-persist storage in %s." 897 org-persist-directory) 898 (org-persist--check-write-access org-persist-directory)))) 899 (when (file-exists-p org-persist-directory) 900 (let ((index-file 901 (org-file-name-concat org-persist-directory org-persist-index-file))) 902 (org-persist--merge-index-with-disk) 903 (org-persist--write-elisp-file index-file org-persist--index t) 904 (setq org-persist--index-age 905 (file-attribute-modification-time (file-attributes index-file))) 906 index-file))) 907 908 (defun org-persist--save-index () 909 "Save `org-persist--index'." 910 (org-persist-write:index 911 `(index ,org-persist--storage-version) nil)) 912 913 (defun org-persist--merge-index-with-disk () 914 "Merge `org-persist--index' with the current index file on disk." 915 (let* ((index-file 916 (org-file-name-concat org-persist-directory org-persist-index-file)) 917 (disk-index 918 (and (file-exists-p index-file) 919 (org-file-newer-than-p index-file org-persist--index-age) 920 (org-persist-read:index `(index ,org-persist--storage-version) index-file nil))) 921 (combined-index 922 (org-persist--merge-index org-persist--index disk-index))) 923 (when disk-index 924 (setq org-persist--index combined-index 925 org-persist--index-age 926 (file-attribute-modification-time (file-attributes index-file)))))) 927 928 (defun org-persist--merge-index (base other) 929 "Attempt to merge new index items in OTHER into BASE. 930 Items with different details are considered too difficult, and skipped." 931 (if other 932 (let ((new (cl-set-difference other base :test #'equal)) 933 (base-files (mapcar (lambda (s) (plist-get s :persist-file)) base)) 934 (combined (reverse base))) 935 (dolist (item (nreverse new)) 936 (unless (or (memq 'index (mapcar #'car (plist-get item :container))) 937 (not (file-exists-p 938 (org-file-name-concat org-persist-directory 939 (plist-get item :persist-file)))) 940 (member (plist-get item :persist-file) base-files)) 941 (push item combined))) 942 (nreverse combined)) 943 base)) 944 945 ;;;; Public API 946 947 (cl-defun org-persist-register (container &optional associated &rest misc 948 &key inherit 949 &key (expiry org-persist-default-expiry) 950 &key (write-immediately nil) 951 &allow-other-keys) 952 "Register CONTAINER in ASSOCIATED to be persistent across Emacs sessions. 953 Optional key INHERIT makes CONTAINER dependent on another container. 954 Such dependency means that data shared between variables will be 955 preserved (see elisp#Circular Objects). 956 Optional key EXPIRY will set the expiry condition of the container. 957 It can be `never', nil - until end of session, a number of days since 958 last access, or a function accepting a single argument - collection. 959 EXPIRY key has no effect when INHERIT is non-nil. 960 Optional key WRITE-IMMEDIATELY controls whether to save the container 961 data immediately. 962 MISC will be appended to the collection. It must be alternating :KEY 963 VALUE pairs. 964 When WRITE-IMMEDIATELY is non-nil, the return value will be the same 965 with `org-persist-write'." 966 (unless org-persist--index (org-persist--load-index)) 967 (setq container (org-persist--normalize-container container)) 968 (when inherit 969 (setq inherit (org-persist--normalize-container inherit)) 970 (let ((inherited-collection (org-persist--get-collection inherit associated)) 971 new-collection) 972 (unless (member container (plist-get inherited-collection :container)) 973 (setq new-collection 974 (plist-put (copy-sequence inherited-collection) :container 975 (cons container (plist-get inherited-collection :container)))) 976 (org-persist--remove-from-index inherited-collection) 977 (org-persist--add-to-index new-collection)))) 978 (let ((collection (org-persist--get-collection container associated misc))) 979 (when (and expiry (not inherit)) 980 (when expiry (plist-put collection :expiry expiry)))) 981 (when (or (bufferp associated) (bufferp (plist-get associated :buffer))) 982 (with-current-buffer (if (bufferp associated) 983 associated 984 (plist-get associated :buffer)) 985 (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local))) 986 (when write-immediately (org-persist-write container associated))) 987 988 (cl-defun org-persist-unregister (container &optional associated &key remove-related) 989 "Unregister CONTAINER in ASSOCIATED to be persistent. 990 When ASSOCIATED is `all', unregister CONTAINER everywhere. 991 When REMOVE-RELATED is non-nil, remove all the containers stored with 992 the CONTAINER as well." 993 (unless org-persist--index (org-persist--load-index)) 994 (setq container (org-persist--normalize-container container)) 995 (if (eq associated 'all) 996 (mapc (lambda (collection) 997 (when (member container (plist-get collection :container)) 998 (org-persist-unregister container (plist-get collection :associated) :remove-related remove-related))) 999 org-persist--index) 1000 (setq associated (org-persist--normalize-associated associated)) 1001 (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) 1002 (when collection 1003 (if (or remove-related (= (length (plist-get collection :container)) 1)) 1004 (org-persist--remove-from-index collection) 1005 (plist-put collection :container 1006 (remove container (plist-get collection :container))) 1007 (org-persist--add-to-index collection)))))) 1008 1009 (cl-defun org-persist-read (container &optional associated hash-must-match load &key read-related) 1010 "Restore CONTAINER data for ASSOCIATED. 1011 When HASH-MUST-MATCH is non-nil, do not restore data if hash for 1012 ASSOCIATED file or buffer does not match. 1013 1014 ASSOCIATED can be a plist, a buffer, or a string. 1015 A buffer is treated as (:buffer ASSOCIATED). 1016 A string is treated as (:file ASSOCIATED). 1017 1018 When LOAD is non-nil, load the data instead of reading. 1019 1020 When READ-RELATED is non-nil, return the data stored alongside with 1021 CONTAINER as well. For example: 1022 1023 (let ((info \"test\")) 1024 (org-persist-register 1025 \\=`(\"My data\" (elisp-data ,info)) 1026 nil :write-immediately t)) 1027 (org-persist-read \"My data\") ; => \"My data\" 1028 (org-persist-read \"My data\" nil nil nil 1029 :read-related t) ; => (\"My data\" \"test\")" 1030 (unless org-persist--index (org-persist--load-index)) 1031 (setq associated (org-persist--normalize-associated associated)) 1032 (setq container (org-persist--normalize-container container)) 1033 (let* ((collection (org-persist--find-index `(:container ,container :associated ,associated))) 1034 (persist-file 1035 (when collection 1036 (org-file-name-concat 1037 org-persist-directory 1038 (plist-get collection :persist-file)))) 1039 (data nil)) 1040 (when (and collection 1041 (or (not (plist-get collection :expiry)) ; current session 1042 (not (org-persist--gc-expired-p 1043 (plist-get collection :expiry) collection))) 1044 (or (not hash-must-match) 1045 (and (plist-get associated :hash) 1046 (equal (plist-get associated :hash) 1047 (plist-get (plist-get collection :associated) :hash)))) 1048 (or (file-exists-p persist-file) 1049 ;; Attempt to write data if it is not yet written. 1050 (progn 1051 (org-persist-write container associated 'no-read) 1052 (file-exists-p persist-file)))) 1053 (unless (seq-find (lambda (v) 1054 (run-hook-with-args-until-success 'org-persist-before-read-hook v associated)) 1055 (plist-get collection :container)) 1056 (setq data (org-persist--read-elisp-file persist-file)) 1057 (when data 1058 (cl-loop for c in (plist-get collection :container) 1059 with result = nil 1060 do 1061 (when (or read-related 1062 (equal c container) 1063 (member c container)) 1064 (if load 1065 (push (org-persist-load:generic c (alist-get c data nil nil #'equal) collection) result) 1066 (push (org-persist-read:generic c (alist-get c data nil nil #'equal) collection) result))) 1067 (run-hook-with-args 'org-persist-after-read-hook c associated) 1068 finally return (if (= 1 (length result)) (car result) (nreverse result)))))))) 1069 1070 (cl-defun org-persist-load (container &optional associated hash-must-match &key read-related) 1071 "Load CONTAINER data for ASSOCIATED. 1072 The arguments CONTAINER, ASSOCIATED, HASH-MUST-MATCH, and READ-RELATED 1073 have the same meaning as in `org-persist-read'." 1074 (org-persist-read container associated hash-must-match t :read-related read-related)) 1075 1076 (defun org-persist-load-all (&optional associated) 1077 "Restore all the persistent data associated with ASSOCIATED." 1078 (unless org-persist--index (org-persist--load-index)) 1079 (setq associated (org-persist--normalize-associated associated)) 1080 (let (all-containers) 1081 (dolist (collection org-persist--index) 1082 (when collection 1083 (cl-pushnew (plist-get collection :container) all-containers :test #'equal))) 1084 (dolist (container all-containers) 1085 (condition-case err 1086 (org-persist-load container associated t) 1087 (error 1088 (message "%s. Deleting bad index entry." err) 1089 (org-persist--remove-from-index (org-persist--find-index `(:container ,container :associated ,associated))) 1090 nil))))) 1091 1092 (defun org-persist-load-all-buffer () 1093 "Call `org-persist-load-all' in current buffer." 1094 (org-persist-load-all (current-buffer))) 1095 1096 (defun org-persist-write (container &optional associated ignore-return) 1097 "Save CONTAINER according to ASSOCIATED. 1098 ASSOCIATED can be a plist, a buffer, or a string. 1099 A buffer is treated as (:buffer ASSOCIATED). 1100 A string is treated as (:file ASSOCIATED). 1101 The return value is nil when writing fails and the written value (as 1102 returned by `org-persist-read') on success. 1103 When IGNORE-RETURN is non-nil, just return t on success without calling 1104 `org-persist-read'." 1105 (setq associated (org-persist--normalize-associated associated)) 1106 ;; Update hash 1107 (when (and (plist-get associated :file) 1108 (plist-get associated :hash) 1109 (get-file-buffer (plist-get associated :file))) 1110 (setq associated (org-persist--normalize-associated (get-file-buffer (plist-get associated :file))))) 1111 (let ((collection (org-persist--get-collection container associated))) 1112 (setf collection (plist-put collection :associated associated)) 1113 (unless (or 1114 ;; Prevent data leakage from encrypted files. 1115 ;; We do it in somewhat paranoid manner and do not 1116 ;; allow anything related to encrypted files to be 1117 ;; written. 1118 (and (plist-get associated :file) 1119 (string-match-p epa-file-name-regexp (plist-get associated :file))) 1120 (seq-find (lambda (v) 1121 (run-hook-with-args-until-success 'org-persist-before-write-hook v associated)) 1122 (plist-get collection :container))) 1123 (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) 1124 (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) 1125 (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) 1126 (plist-get collection :container)))) 1127 (org-persist--write-elisp-file file data) 1128 (or ignore-return (org-persist-read container associated))))))) 1129 1130 (defun org-persist-write-all (&optional associated) 1131 "Save all the persistent data. 1132 When ASSOCIATED is non-nil, only save the matching data." 1133 (unless org-persist--index (org-persist--load-index)) 1134 (setq associated (org-persist--normalize-associated associated)) 1135 (if 1136 (and (equal 1 (length org-persist--index)) 1137 ;; The single collection only contains a single container 1138 ;; in the container list. 1139 (equal 1 (length (plist-get (car org-persist--index) :container))) 1140 ;; The container is an `index' container. 1141 (eq 'index (caar (plist-get (car org-persist--index) :container))) 1142 (or (not (file-exists-p org-persist-directory)) 1143 (org-directory-empty-p org-persist-directory))) 1144 ;; Do not write anything, and clear up `org-persist-directory' to reduce 1145 ;; clutter. 1146 (when (and (file-exists-p org-persist-directory) 1147 (org-directory-empty-p org-persist-directory)) 1148 (delete-directory org-persist-directory)) 1149 ;; Write the data. 1150 (let (all-containers) 1151 (dolist (collection org-persist--index) 1152 (if associated 1153 (when collection 1154 (cl-pushnew (plist-get collection :container) all-containers :test #'equal)) 1155 (condition-case err 1156 (org-persist-write (plist-get collection :container) (plist-get collection :associated) t) 1157 (error 1158 (message "%s. Deleting bad index entry." err) 1159 (org-persist--remove-from-index collection) 1160 nil)))) 1161 (dolist (container all-containers) 1162 (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) 1163 (when collection 1164 (condition-case err 1165 (org-persist-write container associated t) 1166 (error 1167 (message "%s. Deleting bad index entry." err) 1168 (org-persist--remove-from-index collection) 1169 nil)))))))) 1170 1171 (defun org-persist-write-all-buffer () 1172 "Call `org-persist-write-all' in current buffer. 1173 Do nothing in an indirect buffer." 1174 (unless (buffer-base-buffer (current-buffer)) 1175 (org-persist-write-all (current-buffer)))) 1176 1177 (defalias 'org-persist-gc:elisp #'ignore) 1178 (defalias 'org-persist-gc:index #'ignore) 1179 (defalias 'org-persist-gc:elisp-data #'ignore) 1180 (defalias 'org-persist-gc:version #'ignore) 1181 (defalias 'org-persist-gc:file #'ignore) 1182 (defalias 'org-persist-gc:url #'ignore) 1183 1184 (defun org-persist--gc-persist-file (persist-file) 1185 "Garbage collect PERSIST-FILE." 1186 (when (file-exists-p persist-file) 1187 (delete-file persist-file) 1188 (when (org-directory-empty-p (file-name-directory persist-file)) 1189 (delete-directory (file-name-directory persist-file))))) 1190 1191 (defmacro org-persist-associated-files:generic (container collection) 1192 "List associated files in `org-persist-directory' of CONTAINER in COLLECTION." 1193 `(let* ((c (org-persist--normalize-container ,container)) 1194 (assocf-func-symbol (intern (format "org-persist-associated-files:%s" (car c))))) 1195 (if (fboundp assocf-func-symbol) 1196 (funcall assocf-func-symbol c ,collection) 1197 (error "org-persist: Read function %s not defined" 1198 assocf-func-symbol)))) 1199 1200 (defalias 'org-persist-associated-files:elisp #'ignore) 1201 (defalias 'org-persist-associated-files:index #'ignore) 1202 (defalias 'org-persist-associated-files:elisp-data #'ignore) 1203 (defalias 'org-persist-associated-files:version #'ignore) 1204 1205 (defun org-persist-associated-files:file (container collection) 1206 "List file CONTAINER associated files of COLLECTION in `org-persist-directory'." 1207 (let ((file (org-persist-read container (plist-get collection :associated)))) 1208 (when (and file (file-exists-p file)) 1209 (list file)))) 1210 1211 (defun org-persist-associated-files:url (container collection) 1212 "List url CONTAINER associated files of COLLECTION in `org-persist-directory'." 1213 (let ((file (org-persist-read container (plist-get collection :associated)))) 1214 (when (file-exists-p file) 1215 (list file)))) 1216 1217 (defun org-persist--refresh-gc-lock () 1218 "Refresh session timestamp in `org-persist-gc-lock-file'. 1219 Remove expired sessions timestamps." 1220 (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file)) 1221 (alist (when (file-exists-p file) (org-persist--read-elisp-file file))) 1222 new-alist) 1223 (setf (alist-get before-init-time alist nil nil #'equal) 1224 (current-time)) 1225 (dolist (record alist) 1226 (when (< (- (float-time (cdr record)) (float-time (current-time))) 1227 org-persist-gc-lock-expiry) 1228 (push record new-alist))) 1229 (org-persist--write-elisp-file file new-alist))) 1230 1231 (defun org-persist--gc-orphan-p () 1232 "Return non-nil, when orphan files should be garbage-collected. 1233 Remove current sessions from `org-persist-gc-lock-file'." 1234 (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file)) 1235 (alist (when (file-exists-p file) (org-persist--read-elisp-file file)))) 1236 (setq alist (org-assoc-delete-all before-init-time alist)) 1237 (org-persist--write-elisp-file file alist) 1238 ;; Only GC orphan files when there are no active sessions. 1239 (not alist))) 1240 1241 (defun org-persist-gc () 1242 "Remove expired or unregistered containers and orphaned files. 1243 Also, remove containers associated with non-existing files." 1244 (if org-persist--index 1245 (org-persist--merge-index-with-disk) 1246 (org-persist--load-index)) 1247 (let (new-index 1248 (remote-files-num 0) 1249 (orphan-files 1250 (when (org-persist--gc-orphan-p) ; also removes current session from lock file. 1251 (delete (org-file-name-concat org-persist-directory org-persist-index-file) 1252 (when (file-exists-p org-persist-directory) 1253 (directory-files-recursively org-persist-directory ".+")))))) 1254 (dolist (collection org-persist--index) 1255 (let* ((file (plist-get (plist-get collection :associated) :file)) 1256 (web-file (and file (string-match-p "\\`https?://" file))) 1257 (file-remote (when file (file-remote-p file))) 1258 (persist-file (when (plist-get collection :persist-file) 1259 (org-file-name-concat 1260 org-persist-directory 1261 (plist-get collection :persist-file)))) 1262 (expired? (org-persist--gc-expired-p 1263 (plist-get collection :expiry) collection))) 1264 (when persist-file 1265 (setq orphan-files (delete persist-file orphan-files)) 1266 (when (and file (not web-file)) 1267 (when file-remote (cl-incf remote-files-num)) 1268 (unless (if (not file-remote) 1269 (file-exists-p file) 1270 (pcase org-persist-remote-files 1271 ('t t) 1272 ('check-existence 1273 (file-exists-p file)) 1274 ((pred numberp) 1275 (< org-persist-remote-files remote-files-num)) 1276 (_ nil))) 1277 (setq expired? t))) 1278 (if expired? 1279 (org-persist--gc-persist-file persist-file) 1280 (push collection new-index) 1281 (dolist (container (plist-get collection :container)) 1282 (dolist (associated-file 1283 (org-persist-associated-files:generic 1284 container collection)) 1285 (setq orphan-files (delete associated-file orphan-files)))))))) 1286 (mapc #'org-persist--gc-persist-file orphan-files) 1287 (setq org-persist--index (nreverse new-index)))) 1288 1289 (defun org-persist-clear-storage-maybe () 1290 "Clear `org-persist-directory' according to `org-persist--disable-when-emacs-Q'. 1291 1292 When `org-persist--disable-when-emacs-Q' is non-nil and Emacs is called with -Q 1293 command line argument, `org-persist-directory' is created in potentially public 1294 system temporary directory. Remove everything upon existing Emacs in 1295 such scenario." 1296 (when (and org-persist--disable-when-emacs-Q 1297 ;; FIXME: This is relying on undocumented fact that 1298 ;; Emacs sets `user-init-file' to nil when loaded with 1299 ;; "-Q" argument. 1300 (not user-init-file) 1301 (file-exists-p org-persist-directory)) 1302 (delete-directory org-persist-directory 'recursive))) 1303 1304 ;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set. 1305 (when (and org-persist--disable-when-emacs-Q 1306 ;; FIXME: This is relying on undocumented fact that 1307 ;; Emacs sets `user-init-file' to nil when loaded with 1308 ;; "-Q" argument. 1309 (not user-init-file)) 1310 (setq org-persist-directory 1311 (make-temp-file "org-persist-" 'dir))) 1312 1313 ;; Automatically write the data, but only when we have write access. 1314 (when (org-persist--check-write-access org-persist-directory) 1315 (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. 1316 (add-hook 'kill-emacs-hook #'org-persist-write-all) 1317 ;; `org-persist-gc' should run before `org-persist-write-all'. 1318 ;; So we are adding the hook after `org-persist-write-all'. 1319 (add-hook 'kill-emacs-hook #'org-persist-gc)) 1320 1321 (add-hook 'after-init-hook #'org-persist-load-all) 1322 1323 (defvar org-persist--refresh-gc-lock-timer nil 1324 "Timer used to refresh session timestamp in `org-persist-gc-lock-file'.") 1325 1326 (unless (and org-persist--disable-when-emacs-Q 1327 ;; FIXME: This is relying on undocumented fact that 1328 ;; Emacs sets `user-init-file' to nil when loaded with 1329 ;; "-Q" argument. 1330 (not user-init-file)) 1331 (unless org-persist--refresh-gc-lock-timer 1332 (setq org-persist--refresh-gc-lock-timer 1333 (run-at-time nil org-persist-gc-lock-interval #'org-persist--refresh-gc-lock)))) 1334 1335 (provide 'org-persist) 1336 1337 ;;; org-persist.el ends here