2022-01-15 00:20:33 -05:00
;;; org-persist.el --- Persist cached data across Emacs sessions -*- lexical-binding: t; -*-
2021-10-16 09:16:11 -04:00
2022-01-01 15:25:06 -05:00
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
2021-10-16 09:16:11 -04:00
;; Author: Ihor Radchenko <yantar92 at gmail dot com>
;; Keywords: cache, storage
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
2022-06-30 11:33:03 -04:00
;; This file implements persistent cache storage across Emacs sessions.
2022-01-15 00:20:33 -05:00
;; Both global and buffer-local data can be stored. This
;; implementation is not meant to be used to store important data -
;; all the caches should be safe to remove at any time.
;;
;; Example usage:
;;
;; 1. Temporarily cache Elisp symbol value to disk. Remove upon
;; closing Emacs:
;; (org-persist-write 'variable-symbol)
;; (org-persist-read 'variable-symbol) ;; read the data later
;; 2. Temporarily cache a remote URL file to disk. Remove upon
;; closing Emacs:
2022-01-25 21:12:19 -05:00
;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png")
;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png")
2022-01-15 00:20:33 -05:00
;; `org-persist-read' will return the cached file location or nil if cached file
;; has been removed.
;; 3. Temporarily cache a file, including TRAMP path to disk:
2022-01-25 21:12:19 -05:00
;; (org-persist-write 'file "/path/to/file")
2022-01-25 07:11:12 -05:00
;; 4. Cache file or URL while some other file exists.
2022-01-25 21:12:19 -05:00
;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file") :expiry 'never :write-immediately t)
2022-01-25 07:11:12 -05:00
;; or, if the other file is current buffer file
2022-01-25 21:12:19 -05:00
;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") (current-buffer) :expiry 'never :write-immediately t)
2022-01-25 07:11:12 -05:00
;; 5. Cache value of a Elisp variable to disk. The value will be
2022-01-15 00:20:33 -05:00
;; saved and restored automatically (except buffer-local
;; variables).
;; ;; Until `org-persist-default-expiry'
;; (org-persist-register 'variable-symbol)
;; ;; Specify expiry explicitly
;; (org-persist-register 'variable-symbol :expiry 'never)
;; ;; Save buffer-local variable (buffer-local will not be
;; ;; autoloaded!)
;; (org-persist-register 'org-element--cache (current-buffer))
;; ;; Save buffer-local variable preserving circular links:
;; (org-persist-register 'org-element--headline-cache (current-buffer)
;; :inherit 'org-element--cache)
2022-01-25 07:11:12 -05:00
;; 6. Load variable by side effects assigning variable symbol:
2022-01-15 00:20:33 -05:00
;; (org-persist-load 'variable-symbol (current-buffer))
2022-01-25 07:11:12 -05:00
;; 7. Version variable value:
2022-01-25 21:12:19 -05:00
;; (org-persist-register '((elisp variable-symbol) (version "2.0")))
2022-01-25 07:11:12 -05:00
;; 8. Cancel variable persistence:
2022-01-15 00:20:33 -05:00
;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers
;; (org-persist-unregister 'variable-symbol) ;; global variable
;; (org-persist-unregister 'variable-symbol (current-buffer)) ;; buffer-local
2022-01-10 08:30:04 -05:00
;;
;; Most common data type is variable data. However, other data types
;; can also be stored.
;;
;; Persistent data is stored in individual files. Each of the files
;; can contain a collection of related data, which is particularly
;; useful when, say, several variables cross-reference each-other's
;; data-cells and we want to preserve their circular structure.
;;
;; Each data collection can be associated with a local or remote file,
;; its inode number, or contents hash. The persistent data collection
2022-06-30 11:33:03 -04:00
;; can later be accessed using either file buffer, file, inode, or
2022-01-10 08:30:04 -05:00
;; contents hash.
;;
;; The data collections can be versioned and removed upon expiry.
;;
;; In the code below I will use the following naming conventions:
;; 1. Container :: a type of data to be stored
;; Containers can store elisp variables, files, and version
;; numbers. Each container can be customized with container
2022-01-25 21:12:19 -05:00
;; options. For example, `elisp' container is customized with
;; variable symbol. (elisp variable) is a container storing
;; Lisp variable value. Similarly, (version "2.0") container
2022-01-10 08:30:04 -05:00
;; will store version number.
;; 2. Associated :: an object the container is associated with. The
;; object can be a buffer, file, inode number, file contents hash,
;; a generic key, or multiple of them. Associated can also be nil.
;; 3. Data collection :: a list of containers linked to an associated
;; object/objects. Each data collection can also have auxiliary
;; records. Their only purpose is readability of the collection
;; index.
;; 4. Index file :: a file listing all the stored data collections.
;; 5. Persist file :: a file holding data values or references to
;; actual data values for a single data collection. This file
;; contains an alist associating each data container in data
;; collection with its value or a reference to the actual value.
;;
;; All the persistent data is stored in `org-persist-directory'. The data
;; collections are listed in `org-persist-index-file' and the actual data is
;; stored in UID-style subfolders.
;;
;; The `org-persist-index-file' stores the value of `org-persist--index'.
;;
;; Each collection is represented as a plist containing the following
;; properties:
;; - `:container' : list of data continers to be stored in single
;; file;
;; - `:persist-file': data file name;
;; - `:associated' : list of associated objects;
2022-01-15 00:20:33 -05:00
;; - `:last-access' : last date when the container has been accessed;
2022-01-10 08:30:04 -05:00
;; - `:expiry' : list of expiry conditions.
;; - all other keywords are ignored
;;
;; The available types of data containers are:
2022-01-25 21:12:19 -05:00
;; 1. (file variable-symbol) or just variable-symbol :: Storing
2022-01-10 08:30:04 -05:00
;; elisp variable data.
2022-01-25 21:12:19 -05:00
;; 2. (file) :: Store a copy of the associated file preserving the
2022-01-10 08:30:04 -05:00
;; extension.
2022-01-25 21:12:19 -05:00
;; (file "/path/to/a/file") :: Store a copy of the file in path.
;; 3. (version "version number") :: Version the data collection.
2022-01-10 08:30:04 -05:00
;; If the stored collection has different version than "version
;; number", disregard it.
2022-01-25 21:12:19 -05:00
;; 4. (url) :: Store a downloaded copy of URL object.
2022-01-10 08:30:04 -05:00
;;
;; The data collections can expire, in which case they will be removed
;; from the persistent storage at the end of Emacs session. The
;; expiry condition can be set when saving/registering data
2022-01-14 22:53:59 -05:00
;; containers. The expirty condition can be `never' - data will never
2022-01-10 08:30:04 -05:00
;; expire; `nil' - data will expire at the end of current Emacs session;
;; a number - data will expire after the number days from last access;
;; a function - data will expire if the function, called with a single
;; argument - collection, returns non-nil.
2022-01-15 00:20:33 -05:00
;;
;;
;; Data collections associated with files will automatically expire
;; when the file is removed. If the associated file is remote, the
;; expiry is controlled by `org-persist-remote-files' instead.
;;
;; Data loading/writing can be more accurately controlled using
;; `org-persist-before-write-hook', `org-persist-before-read-hook', and `org-persist-after-read-hook'.
2021-10-16 09:16:11 -04:00
;;; Code:
2022-08-04 09:53:05 -04:00
( require 'org-macs )
( org-assert-version )
2021-10-16 09:16:11 -04:00
( require 'org-compat )
( require 'org-id )
2021-11-09 20:45:16 -05:00
( require 'xdg nil t )
2021-10-16 09:16:11 -04:00
2022-01-15 00:26:37 -05:00
( declare-function org-back-to-heading " org " ( &optional invisible-ok ) )
( declare-function org-next-visible-heading " org " ( arg ) )
( declare-function org-at-heading-p " org " ( &optional invisible-not-ok ) )
2022-12-07 08:04:06 -05:00
( defconst org-persist--storage-version " 2.7 "
2022-01-10 08:30:04 -05:00
" Persistent storage layout version. " )
2021-12-18 09:13:24 -05:00
( defgroup org-persist nil
" Persistent cache for Org mode. "
:tag " Org persist "
:group 'org )
( defcustom org-persist-directory ( expand-file-name
2022-11-13 02:29:15 -05:00
( org-file-name-concat
( let ( ( cache-dir ( when ( fboundp 'xdg-cache-home )
( xdg-cache-home ) ) ) )
( if ( or ( seq-empty-p cache-dir )
( not ( file-exists-p cache-dir ) )
( file-exists-p ( org-file-name-concat
user-emacs-directory
" org-persist " ) ) )
user-emacs-directory
cache-dir ) )
" org-persist/ " ) )
2021-12-18 09:13:24 -05:00
" Directory where the data is stored. "
2022-11-13 02:29:15 -05:00
:group 'org-persist
:package-version ' ( Org . " 9.6 " )
2021-12-18 09:13:24 -05:00
:type 'directory )
2021-10-16 09:16:11 -04:00
2022-01-10 08:30:04 -05:00
( defcustom org-persist-remote-files 100
" Whether to keep persistent data for remote files.
2022-11-30 10:59:41 -05:00
When this variable is nil , never save persistent data associated with
2022-01-14 22:53:59 -05:00
remote files. When t , always keep the data. When
2022-01-10 08:30:04 -05:00
` check-existence ', contact remote server containing the file and only
2022-01-14 22:53:59 -05:00
keep the data when the file exists on the server. When a number, keep
2022-01-10 08:30:04 -05:00
up to that number persistent values for remote files.
Note that the last option ` check-existence ' may cause Emacs to show
password prompts to log in. "
:group 'org-persist
2022-11-13 02:29:15 -05:00
:package-version ' ( Org . " 9.6 " )
2022-01-10 08:30:04 -05:00
:type ' ( choice ( const :tag " Never " nil )
( const :tag " Always " t )
( number :tag " Keep not more than X files " )
2022-06-13 10:15:10 -04:00
( const :tag " Check if exist on remote " check-existence ) ) )
2022-01-10 08:30:04 -05:00
2022-01-12 05:18:17 -05:00
( defcustom org-persist-default-expiry 30
" Default expiry condition for persistent data.
2022-01-14 22:53:59 -05:00
When this variable is nil , all the data vanishes at the end of Emacs
2022-01-12 05:18:17 -05:00
session. When ` never ', the data never vanishes. When a number, the
data is deleted that number days after last access. When a function,
it should be a function returning non-nil when the data is expired. The
function will be called with a single argument - collection. "
:group 'org-persist
2022-11-13 02:29:15 -05:00
:package-version ' ( Org . " 9.6 " )
2022-06-13 10:15:10 -04:00
:type ' ( choice ( const :tag " Never " never )
2022-01-12 05:18:17 -05:00
( const :tag " Always " nil )
( number :tag " Keep N days " )
( function :tag " Function " ) ) )
2022-01-10 08:30:04 -05:00
( defconst org-persist-index-file " index "
2021-10-16 09:16:11 -04:00
" File name used to store the data index. " )
2022-06-01 22:56:45 -04:00
( defvar org-persist-disable-when-emacs-Q t
" Disable persistence when Emacs is called with -Q command line arg. " )
2021-10-16 09:16:11 -04:00
( defvar org-persist-before-write-hook nil
2022-01-10 08:30:04 -05:00
" Abnormal hook ran before saving data.
2021-10-16 09:16:11 -04:00
The hook must accept the same arguments as ` org-persist-write '.
The hooks will be evaluated until a hook returns non-nil.
If any of the hooks return non-nil, do not save the data. " )
( defvar org-persist-before-read-hook nil
2022-01-10 08:30:04 -05:00
" Abnormal hook ran before reading data.
2021-10-16 09:16:11 -04:00
The hook must accept the same arguments as ` org-persist-read '.
The hooks will be evaluated until a hook returns non-nil.
If any of the hooks return non-nil, do not read the data. " )
( defvar org-persist-after-read-hook nil
2022-01-10 08:30:04 -05:00
" Abnormal hook ran after reading data.
2021-10-16 09:16:11 -04:00
The hook must accept the same arguments as ` org-persist-read '. " )
( defvar org-persist--index nil
" Global index.
The index is a list of plists. Each plist contains information about
2022-01-10 08:30:04 -05:00
persistent data storage. Each plist contains the following
properties:
2021-10-16 09:16:11 -04:00
2022-01-10 08:30:04 -05:00
- ` :container ' : list of data continers to be stored in single file
2021-10-16 09:16:11 -04:00
- ` :persist-file ' : data file name
2022-01-10 08:30:04 -05:00
- ` :associated ' : list of associated objects
- ` :last-access ' : last date when the container has been read
- ` :expiry ' : list of expiry conditions
- all other keywords are ignored. " )
( defvar org-persist--index-hash nil
" Hash table storing `org-persist--index' . Used for quick access.
They keys are conses of ( container . associated ) . " )
2021-10-16 09:16:11 -04:00
2021-12-25 10:33:29 -05:00
( defvar org-persist--report-time 0.5
" Whether to report read/write time.
When the value is a number, it is a threshold number of seconds. If
2022-06-30 11:33:03 -04:00
the read/write time of a single variable exceeds the threshold, a
2021-12-25 10:33:29 -05:00
message is displayed.
When the value is a non-nil non-number, always display the message.
2022-06-30 11:33:03 -04:00
When the value is nil , never display the message. " )
2021-12-25 10:33:29 -05:00
2022-01-10 08:30:04 -05:00
;;;; Common functions
( defun org-persist--display-time ( duration format &rest args )
" Report DURATION according to FORMAT + ARGS message.
FORMAT and ARGS are passed to ` message '. "
( when ( or ( and org-persist--report-time
( numberp org-persist--report-time )
( >= duration org-persist--report-time ) )
( and org-persist--report-time
( not ( numberp org-persist--report-time ) ) ) )
( apply #' message
( format " org-persist: %s took %%.2f sec " format )
( append args ( list duration ) ) ) ) )
( defun org-persist--read-elisp-file ( &optional buffer-or-file )
" Read elisp data from BUFFER-OR-FILE or current buffer. "
( unless buffer-or-file ( setq buffer-or-file ( current-buffer ) ) )
( with-temp-buffer
( if ( bufferp buffer-or-file )
( set-buffer buffer-or-file )
( insert-file-contents buffer-or-file ) )
( condition-case err
( let ( ( coding-system-for-read 'utf-8 )
( read-circle t )
( start-time ( float-time ) ) )
2021-10-16 09:16:11 -04:00
;; FIXME: Reading sometimes fails to read circular objects.
;; I suspect that it happens when we have object reference
;; #N# read before object definition #N=. If it is really
2021-10-19 08:07:18 -04:00
;; so, it should be Emacs bug - either in `read' or in
;; `prin1'. Meanwhile, just fail silently when `read'
;; fails to parse the saved cache object.
2022-01-10 08:30:04 -05:00
( prog1
( read ( current-buffer ) )
( org-persist--display-time
( - ( float-time ) start-time )
" Reading from %S " buffer-or-file ) ) )
;; Recover gracefully if index file is corrupted.
( error
;; Remove problematic file.
( unless ( bufferp buffer-or-file ) ( delete-file buffer-or-file ) )
;; Do not report the known error to user.
2022-06-20 21:33:40 -04:00
( if ( string-match-p " Invalid read syntax " ( error-message-string err ) )
( message " Emacs reader failed to read data in %S. The error was: %S "
buffer-or-file ( error-message-string err ) )
2022-01-10 08:30:04 -05:00
( warn " Emacs reader failed to read data in %S. The error was: %S "
buffer-or-file ( error-message-string err ) ) )
nil ) ) ) )
( defun org-persist--write-elisp-file ( file data &optional no-circular pp )
" Write elisp DATA to FILE. "
( let ( ( print-circle ( not no-circular ) )
print-level
print-length
print-quoted
( print-escape-control-characters t )
( print-escape-nonascii t )
( print-continuous-numbering t )
print-number-table
( start-time ( float-time ) ) )
( unless ( file-exists-p ( file-name-directory file ) )
( make-directory ( file-name-directory file ) t ) )
( with-temp-file file
( if pp
( pp data ( current-buffer ) )
( prin1 data ( current-buffer ) ) ) )
( org-persist--display-time
( - ( float-time ) start-time )
" Writing to %S " file ) ) )
2022-01-14 23:23:51 -05:00
( defmacro org-persist-gc:generic ( container collection )
" Garbage collect CONTAINER data from COLLECTION. "
` ( let* ( ( c ( org-persist--normalize-container , container ) )
( gc-func-symbol ( intern ( format " org-persist-gc:%s " ( car c ) ) ) ) )
( unless ( fboundp gc-func-symbol )
( error " org-persist: GC function %s not defined "
gc-func-symbol ) )
( funcall gc-func-symbol c , collection ) ) )
2022-01-25 21:09:40 -05:00
( defmacro org-persist--gc-expired-p ( cnd collection )
" Check if expiry condition CND triggers for COLLECTION. "
` ( pcase , cnd
( ` nil t )
( ` never nil )
( ( pred numberp )
2022-06-17 07:23:28 -04:00
( when ( plist-get , collection :last-access )
2022-06-20 21:32:41 -04:00
( > ( float-time ) ( + ( plist-get , collection :last-access ) ( * , cnd 24 60 60 ) ) ) ) )
2022-01-25 21:09:40 -05:00
( ( pred functionp )
( funcall , cnd , collection ) )
( _ ( error " org-persist: Unsupported expiry type %S " , cnd ) ) ) )
2022-01-10 08:30:04 -05:00
;;;; Working with index
( defmacro org-persist-collection-let ( collection &rest body )
" Bind container and associated from COLLECTION and execute BODY. "
( declare ( debug ( form body ) ) ( indent 1 ) )
2022-01-14 23:23:51 -05:00
` ( with-no-warnings
( let* ( ( container ( plist-get , collection :container ) )
( associated ( plist-get , collection :associated ) )
( path ( plist-get associated :file ) )
( inode ( plist-get associated :inode ) )
( hash ( plist-get associated :hash ) )
( key ( plist-get associated :key ) ) )
2022-07-24 08:57:07 -04:00
;; Suppress "unused variable" warnings.
( ignore container associated path inode hash key )
2022-01-14 23:23:51 -05:00
,@ body ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist--find-index ( collection )
2022-01-14 23:23:51 -05:00
" Find COLLECTION in `org-persist--index' . "
( org-persist-collection-let collection
( and org-persist--index-hash
( catch :found
( dolist ( cont ( cons container container ) )
( let ( r )
( setq r ( or ( gethash ( cons cont associated ) org-persist--index-hash )
( and path ( gethash ( cons cont ( list :file path ) ) org-persist--index-hash ) )
( and inode ( gethash ( cons cont ( list :inode inode ) ) org-persist--index-hash ) )
( and hash ( gethash ( cons cont ( list :hash hash ) ) org-persist--index-hash ) )
( and key ( gethash ( cons cont ( list :key key ) ) org-persist--index-hash ) ) ) )
( when r ( throw :found r ) ) ) ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist--add-to-index ( collection &optional hash-only )
" Add or update COLLECTION in `org-persist--index' .
When optional HASH-ONLY is non-nil, only modify the hash table.
Return PLIST. "
( org-persist-collection-let collection
( let ( ( existing ( org-persist--find-index collection ) ) )
( if existing
( progn
( plist-put existing :container container )
( plist-put ( plist-get existing :associated ) :file path )
( plist-put ( plist-get existing :associated ) :inode inode )
( plist-put ( plist-get existing :associated ) :hash hash )
( plist-put ( plist-get existing :associated ) :key key )
existing )
( unless hash-only ( push collection org-persist--index ) )
( unless org-persist--index-hash ( setq org-persist--index-hash ( make-hash-table :test 'equal ) ) )
( dolist ( cont ( cons container container ) )
( puthash ( cons cont associated ) collection org-persist--index-hash )
( when path ( puthash ( cons cont ( list :file path ) ) collection org-persist--index-hash ) )
( when inode ( puthash ( cons cont ( list :inode inode ) ) collection org-persist--index-hash ) )
( when hash ( puthash ( cons cont ( list :hash inode ) ) collection org-persist--index-hash ) )
( when key ( puthash ( cons cont ( list :key inode ) ) collection org-persist--index-hash ) ) )
collection ) ) ) )
( defun org-persist--remove-from-index ( collection )
" Remove COLLECTION from `org-persist--index' . "
( let ( ( existing ( org-persist--find-index collection ) ) )
( when existing
( org-persist-collection-let collection
( dolist ( cont ( cons container container ) )
2022-01-12 08:30:04 -05:00
( unless ( listp ( car container ) )
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( org-persist-gc:generic cont collection )
( dolist ( afile ( org-persist-associated-files:generic cont collection ) )
( delete-file afile ) ) )
2022-01-10 08:30:04 -05:00
( remhash ( cons cont associated ) org-persist--index-hash )
( when path ( remhash ( cons cont ( list :file path ) ) org-persist--index-hash ) )
( when inode ( remhash ( cons cont ( list :inode inode ) ) org-persist--index-hash ) )
( when hash ( remhash ( cons cont ( list :hash hash ) ) org-persist--index-hash ) )
( when key ( remhash ( cons cont ( list :key key ) ) org-persist--index-hash ) ) ) )
( setq org-persist--index ( delq existing org-persist--index ) ) ) ) )
( defun org-persist--get-collection ( container &optional associated &rest misc )
" Return or create collection used to store CONTAINER for ASSOCIATED.
When ASSOCIATED is nil , it is a global CONTAINER.
ASSOCIATED can also be a ( :buffer buffer ) or buffer, ( :file file-path )
2022-01-14 22:53:59 -05:00
or file-path, ( :inode inode ) , ( :hash hash ) , or or ( :key key ) .
MISC, if non-nil will be appended to the collection. "
2022-01-10 08:30:04 -05:00
( unless ( and ( listp container ) ( listp ( car container ) ) )
( setq container ( list container ) ) )
( setq associated ( org-persist--normalize-associated associated ) )
( unless ( equal misc ' ( nil ) )
( setq associated ( append associated misc ) ) )
( or ( org-persist--find-index
` ( :container , ( org-persist--normalize-container container )
:associated , associated ) )
( org-persist--add-to-index
( list :container ( org-persist--normalize-container container )
:persist-file
( replace-regexp-in-string " ^.. " " \\ &/ " ( org-id-uuid ) )
:associated associated ) ) ) )
;;;; Reading container data.
( defun org-persist--normalize-container ( container )
" Normalize CONTAINER representation into (type . settings). "
( if ( and ( listp container ) ( listp ( car container ) ) )
( mapcar #' org-persist--normalize-container container )
( pcase container
2022-01-25 21:12:19 -05:00
( ( or ` elisp ` version ` file ` index ` url )
2022-01-10 08:30:04 -05:00
( list container nil ) )
2022-01-25 21:12:19 -05:00
( ( pred symbolp )
( list ` elisp container ) )
( ` ( , ( or ` elisp ` version ` file ` index ` url ) . , _ )
2022-01-10 08:30:04 -05:00
container )
( _ ( error " org-persist: Unknown container type: %S " container ) ) ) ) )
2022-01-12 05:17:50 -05:00
( defvar org-persist--associated-buffer-cache ( make-hash-table :weakness 'key )
" Buffer hash cache. " )
2022-01-10 08:30:04 -05:00
( defun org-persist--normalize-associated ( associated )
" Normalize ASSOCIATED representation into (:type value). "
( pcase associated
2022-01-25 07:12:20 -05:00
( ( or ( pred stringp ) ` ( :file , _ ) )
2022-01-23 02:04:59 -05:00
( unless ( stringp associated )
( setq associated ( cadr associated ) ) )
2022-01-10 08:30:04 -05:00
( let* ( ( rtn ` ( :file , associated ) )
( inode ( and ( fboundp 'file-attribute-inode-number )
( file-attribute-inode-number
( file-attributes associated ) ) ) ) )
( when inode ( plist-put rtn :inode inode ) )
rtn ) )
2022-01-25 07:12:20 -05:00
( ( or ( pred bufferp ) ` ( :buffer , _ ) )
2022-01-23 02:04:59 -05:00
( unless ( bufferp associated )
( setq associated ( cadr associated ) ) )
2022-01-12 05:17:50 -05:00
( let ( ( cached ( gethash associated org-persist--associated-buffer-cache ) )
file inode hash )
( if ( and cached ( eq ( buffer-modified-tick associated )
( car cached ) ) )
( progn
( setq file ( nth 1 cached )
inode ( nth 2 cached )
hash ( nth 3 cached ) ) )
( setq file ( buffer-file-name
( or ( buffer-base-buffer associated )
associated ) ) )
( setq inode ( when ( and file
( fboundp 'file-attribute-inode-number ) )
( file-attribute-inode-number
( file-attributes file ) ) ) )
( setq hash ( secure-hash 'md5 associated ) )
( puthash associated
( list ( buffer-modified-tick associated )
file inode hash )
org-persist--associated-buffer-cache ) )
2022-01-10 08:30:04 -05:00
( let ( ( rtn ` ( :hash , hash ) ) )
( when file ( setq rtn ( plist-put rtn :file file ) ) )
( when inode ( setq rtn ( plist-put rtn :inode inode ) ) )
rtn ) ) )
( ( pred listp )
associated )
( _ ( error " Unknown associated object %S " associated ) ) ) )
( defmacro org-persist-read:generic ( container reference-data collection )
" Read and return the data stored in CONTAINER.
REFERENCE-DATA is associated with CONTAINER in the persist file.
2022-06-30 11:33:03 -04:00
COLLECTION is the plist holding data collection. "
2022-01-10 08:30:04 -05:00
` ( let* ( ( c ( org-persist--normalize-container , container ) )
( read-func-symbol ( intern ( format " org-persist-read:%s " ( car c ) ) ) ) )
( setf , collection ( plist-put , collection :last-access ( float-time ) ) )
2022-01-14 22:47:27 -05:00
( setf , collection ( plist-put , collection :last-access-hr ( format-time-string " %FT%T%z " ( float-time ) ) ) )
2022-01-10 08:30:04 -05:00
( unless ( fboundp read-func-symbol )
( error " org-persist: Read function %s not defined "
read-func-symbol ) )
( funcall read-func-symbol c , reference-data , collection ) ) )
2022-01-23 02:04:59 -05:00
( defun org-persist-read:elisp ( _ lisp-value __ )
2022-01-14 22:53:59 -05:00
" Read elisp container and return LISP-VALUE. "
2022-01-10 08:30:04 -05:00
lisp-value )
2022-01-23 02:04:59 -05:00
( defun org-persist-read:version ( container _ __ )
2022-01-14 22:53:59 -05:00
" Read version CONTAINER. "
2022-01-10 08:30:04 -05:00
( cadr container ) )
2022-01-23 02:04:59 -05:00
( defun org-persist-read:file ( _ path __ )
2022-01-14 22:53:59 -05:00
" Read file container from PATH. "
2022-01-10 08:30:04 -05:00
( when ( and path ( file-exists-p ( concat org-persist-directory path ) ) )
( concat org-persist-directory path ) ) )
2022-01-23 02:04:59 -05:00
( defun org-persist-read:url ( _ path __ )
2022-01-14 22:53:59 -05:00
" Read file container from PATH. "
2022-01-10 08:30:04 -05:00
( when ( and path ( file-exists-p ( concat org-persist-directory path ) ) )
( concat org-persist-directory path ) ) )
( defun org-persist-read:index ( cont index-file _ )
2022-01-14 22:53:59 -05:00
" Read index container CONT from INDEX-FILE. "
2022-01-10 08:30:04 -05:00
( when ( file-exists-p index-file )
( let ( ( index ( org-persist--read-elisp-file index-file ) ) )
( when index
( catch :found
( dolist ( collection index )
( org-persist-collection-let collection
( when ( and ( not associated )
( pcase container
2022-01-25 21:12:19 -05:00
( ` ( ( index , version ) )
2022-01-10 08:30:04 -05:00
( equal version ( cadr cont ) ) )
( _ nil ) ) )
( throw :found index ) ) ) ) ) ) ) ) )
;;;; Applying container data for side effects.
( defmacro org-persist-load:generic ( container reference-data collection )
" Load the data stored in CONTAINER for side effects.
REFERENCE-DATA is associated with CONTAINER in the persist file.
2022-06-30 11:33:03 -04:00
COLLECTION is the plist holding data collection. "
2022-01-10 08:30:04 -05:00
` ( let* ( ( container ( org-persist--normalize-container , container ) )
( load-func-symbol ( intern ( format " org-persist-load:%s " ( car container ) ) ) ) )
( setf , collection ( plist-put , collection :last-access ( float-time ) ) )
2022-01-14 22:47:27 -05:00
( setf , collection ( plist-put , collection :last-access-hr ( format-time-string " %FT%T%z " ( float-time ) ) ) )
2022-01-10 08:30:04 -05:00
( unless ( fboundp load-func-symbol )
( error " org-persist: Load function %s not defined "
load-func-symbol ) )
( funcall load-func-symbol container , reference-data , collection ) ) )
2022-01-14 22:46:37 -05:00
( defun org-persist-load:elisp ( container lisp-value collection )
2022-01-14 22:53:59 -05:00
" Assign elisp CONTAINER in COLLECTION LISP-VALUE. "
2022-01-10 08:30:04 -05:00
( let ( ( lisp-symbol ( cadr container ) )
2022-01-14 22:46:37 -05:00
( buffer ( when ( plist-get ( plist-get collection :associated ) :file )
( get-file-buffer ( plist-get ( plist-get collection :associated ) :file ) ) ) ) )
2022-01-10 08:30:04 -05:00
( if buffer
( with-current-buffer buffer
( make-variable-buffer-local lisp-symbol )
( set lisp-symbol lisp-value ) )
( set lisp-symbol lisp-value ) ) ) )
( defalias 'org-persist-load:version #' org-persist-read:version )
( defalias 'org-persist-load:file #' org-persist-read:file )
( defun org-persist-load:index ( container index-file _ )
2022-01-14 22:53:59 -05:00
" Load `org-persist--index' from INDEX-FILE according to CONTAINER. "
2022-01-10 08:30:04 -05:00
( unless org-persist--index
( setq org-persist--index ( org-persist-read:index container index-file nil ) )
( setq org-persist--index-hash nil )
( if org-persist--index
( mapc ( lambda ( collection ) ( org-persist--add-to-index collection 'hash ) ) org-persist--index )
( setq org-persist--index nil )
2022-01-12 07:33:22 -05:00
( when ( file-exists-p org-persist-directory )
2022-11-30 07:23:38 -05:00
( dolist ( file ( directory-files org-persist-directory 'absolute
" \\ ` [^.][^.] " ) )
2022-01-12 07:33:22 -05:00
( if ( file-directory-p file )
( delete-directory file t )
( delete-file file ) ) ) )
2022-01-10 08:30:04 -05:00
( plist-put ( org-persist--get-collection container ) :expiry 'never ) ) ) )
( defun org-persist--load-index ( )
2022-12-10 08:41:46 -05:00
" Load `org-persist--index' . "
2022-01-10 08:30:04 -05:00
( org-persist-load:index
2022-01-25 21:12:19 -05:00
` ( index , org-persist--storage-version )
2022-01-10 08:30:04 -05:00
( org-file-name-concat org-persist-directory org-persist-index-file )
nil ) )
;;;; Writing container data
( defmacro org-persist-write:generic ( container collection )
" Write CONTAINER in COLLECTION. "
` ( let* ( ( c ( org-persist--normalize-container , container ) )
( write-func-symbol ( intern ( format " org-persist-write:%s " ( car c ) ) ) ) )
2022-01-14 22:47:27 -05:00
( setf , collection ( plist-put , collection :last-access ( float-time ) ) )
( setf , collection ( plist-put , collection :last-access-hr ( format-time-string " %FT%T%z " ( float-time ) ) ) )
2022-01-10 08:30:04 -05:00
( unless ( fboundp write-func-symbol )
( error " org-persist: Write function %s not defined "
write-func-symbol ) )
( funcall write-func-symbol c , collection ) ) )
( defun org-persist-write:elisp ( container collection )
2022-01-14 22:53:59 -05:00
" Write elisp CONTAINER according to COLLECTION. "
2022-01-10 08:30:04 -05:00
( if ( and ( plist-get ( plist-get collection :associated ) :file )
( get-file-buffer ( plist-get ( plist-get collection :associated ) :file ) ) )
2022-02-13 03:53:59 -05:00
( let ( ( buf ( get-file-buffer ( plist-get ( plist-get collection :associated ) :file ) ) ) )
2022-02-13 23:41:37 -05:00
;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28.
;; Not using it yet to keep backward compatibility.
( condition-case nil
( buffer-local-value ( cadr container ) buf )
( void-variable nil ) ) )
2022-02-13 03:53:59 -05:00
( when ( boundp ( cadr container ) )
( symbol-value ( cadr container ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defalias 'org-persist-write:version #' ignore )
2022-01-25 07:11:12 -05:00
( defun org-persist-write:file ( c collection )
" Write file container C according to COLLECTION. "
2022-01-10 08:30:04 -05:00
( org-persist-collection-let collection
2022-01-25 07:11:12 -05:00
( when ( or ( and path ( file-exists-p path ) )
( and ( stringp ( cadr c ) ) ( file-exists-p ( cadr c ) ) ) )
( when ( and ( stringp ( cadr c ) ) ( file-exists-p ( cadr c ) ) )
( setq path ( cadr c ) ) )
2022-01-10 08:30:04 -05:00
( let* ( ( persist-file ( plist-get collection :persist-file ) )
( ext ( file-name-extension path ) )
( file-copy ( org-file-name-concat
org-persist-directory
2022-01-25 07:11:12 -05:00
( format " %s-%s.%s " persist-file ( md5 path ) ext ) ) ) )
2022-01-10 08:30:04 -05:00
( unless ( file-exists-p ( file-name-directory file-copy ) )
( make-directory ( file-name-directory file-copy ) t ) )
2022-01-25 21:11:31 -05:00
( copy-file path file-copy 'overwrite )
2022-01-25 07:11:12 -05:00
( format " %s-%s.%s " persist-file ( md5 path ) ext ) ) ) ) )
2022-01-10 08:30:04 -05:00
2022-01-25 07:11:12 -05:00
( defun org-persist-write:url ( c collection )
" Write url container C according to COLLECTION. "
2022-01-10 08:30:04 -05:00
( org-persist-collection-let collection
2022-01-25 07:11:12 -05:00
( when ( or path ( cadr c ) )
( when ( cadr c ) ( setq path ( cadr c ) ) )
2022-01-10 08:30:04 -05:00
( let* ( ( persist-file ( plist-get collection :persist-file ) )
( ext ( file-name-extension path ) )
( file-copy ( org-file-name-concat
org-persist-directory
2022-01-25 07:11:12 -05:00
( format " %s-%s.%s " persist-file ( md5 path ) ext ) ) ) )
2022-12-10 12:41:39 -05:00
( unless ( file-exists-p file-copy )
( unless ( file-exists-p ( file-name-directory file-copy ) )
( make-directory ( file-name-directory file-copy ) t ) )
( if ( org--should-fetch-remote-resource-p path )
( url-copy-file path file-copy 'overwrite )
( error " The remote resource %S is considered unsafe, and will not be downloaded. "
path ) ) )
2022-01-25 07:11:12 -05:00
( format " %s-%s.%s " persist-file ( md5 path ) ext ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-write:index ( container _ )
2022-01-14 22:53:59 -05:00
" Write index CONTAINER. "
2022-01-10 08:30:04 -05:00
( org-persist--get-collection container )
( unless ( file-exists-p org-persist-directory )
( make-directory org-persist-directory ) )
( unless ( file-exists-p org-persist-directory )
( warn " Failed to create org-persist storage in %s. "
org-persist-directory )
( let ( ( dir ( directory-file-name
( file-name-as-directory org-persist-directory ) ) ) )
( while ( and ( not ( file-exists-p dir ) )
( not ( equal dir ( setq dir ( directory-file-name
( file-name-directory dir ) ) ) ) ) ) )
( unless ( file-writable-p dir )
( message " Missing write access rights to org-persist-directory: %S "
org-persist-directory ) ) ) )
( when ( file-exists-p org-persist-directory )
( org-persist--write-elisp-file
( org-file-name-concat org-persist-directory org-persist-index-file )
org-persist--index
t t )
2022-01-25 21:11:08 -05:00
( org-file-name-concat org-persist-directory org-persist-index-file ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist--save-index ( )
2022-12-10 08:41:46 -05:00
" Save `org-persist--index' . "
2022-01-10 08:30:04 -05:00
( org-persist-write:index
2022-01-25 21:12:19 -05:00
` ( index , org-persist--storage-version ) nil ) )
2022-01-10 08:30:04 -05:00
;;;; Public API
2022-01-25 10:41:41 -05:00
( cl-defun org-persist-register ( container &optional associated &rest misc
&key inherit
&key ( expiry org-persist-default-expiry )
&key ( write-immediately nil )
&allow-other-keys )
2022-01-10 08:30:04 -05:00
" Register CONTAINER in ASSOCIATED to be persistent across Emacs sessions.
Optional key INHERIT makes CONTAINER dependent on another container.
Such dependency means that data shared between variables will be
preserved ( see elisp#Circular Objects ) .
Optional key EXPIRY will set the expiry condition of the container.
2022-01-14 22:53:59 -05:00
It can be ` never ', nil - until end of session, a number of days since
2022-01-10 08:30:04 -05:00
last access, or a function accepting a single argument - collection.
2022-01-14 22:53:59 -05:00
EXPIRY key has no effect when INHERIT is non-nil.
2022-01-25 10:41:41 -05:00
Optional key WRITE-IMMEDIATELY controls whether to save the container
data immediately.
2022-01-25 21:49:52 -05:00
MISC will be appended to CONTAINER.
When WRITE-IMMEDIATELY is non-nil, the return value will be the same
with ` org-persist-write '. "
2022-01-10 08:30:04 -05:00
( unless org-persist--index ( org-persist--load-index ) )
( setq container ( org-persist--normalize-container container ) )
( when inherit
( setq inherit ( org-persist--normalize-container inherit ) )
( let ( ( inherited-collection ( org-persist--get-collection inherit associated ) )
new-collection )
( unless ( member container ( plist-get inherited-collection :container ) )
( setq new-collection
( plist-put ( copy-sequence inherited-collection ) :container
( cons container ( plist-get inherited-collection :container ) ) ) )
( org-persist--remove-from-index inherited-collection )
( org-persist--add-to-index new-collection ) ) ) )
( let ( ( collection ( org-persist--get-collection container associated misc ) ) )
( when ( and expiry ( not inherit ) )
( when expiry ( plist-put collection :expiry expiry ) ) ) )
( when ( or ( bufferp associated ) ( bufferp ( plist-get associated :buffer ) ) )
( with-current-buffer ( if ( bufferp associated )
associated
( plist-get associated :buffer ) )
2022-01-25 21:49:52 -05:00
( add-hook 'kill-buffer-hook #' org-persist-write-all-buffer nil 'local ) ) )
( when write-immediately ( org-persist-write container associated ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-unregister ( container &optional associated )
" Unregister CONTAINER in ASSOCIATED to be persistent.
When ASSOCIATED is ` all ', unregister CONTAINER everywhere. "
( unless org-persist--index ( org-persist--load-index ) )
2022-01-12 07:34:41 -05:00
( setq container ( org-persist--normalize-container container ) )
( setq associated ( org-persist--normalize-associated associated ) )
2022-01-10 08:30:04 -05:00
( if ( eq associated 'all )
( mapc ( lambda ( collection )
( when ( member container ( plist-get collection :container ) )
( org-persist-unregister container ( plist-get collection :associated ) ) ) )
org-persist--index )
2022-01-12 07:34:41 -05:00
( let ( ( collection ( org-persist--find-index ` ( :container , container :associated , associated ) ) ) )
( when collection
( if ( = ( length ( plist-get collection :container ) ) 1 )
( org-persist--remove-from-index collection )
( plist-put collection :container
( remove container ( plist-get collection :container ) ) )
( org-persist--add-to-index collection ) ) ) ) ) )
2022-01-10 08:30:04 -05:00
2022-06-20 21:35:01 -04:00
( defvar org-persist--write-cache ( make-hash-table :test #' equal )
" Hash table storing as-written data objects.
This data is used to avoid reading the data multiple times. " )
2022-01-10 08:30:04 -05:00
( defun org-persist-read ( container &optional associated hash-must-match load? )
" Restore CONTAINER data for ASSOCIATED.
When HASH-MUST-MATCH is non-nil, do not restore data if hash for
ASSOCIATED file or buffer does not match.
ASSOCIATED can be a plist, a buffer, or a string.
A buffer is treated as ( :buffer ASSOCIATED ) .
2022-01-14 22:53:59 -05:00
A string is treated as ( :file ASSOCIATED ) .
When LOAD? is non-nil, load the data instead of reading. "
2022-12-10 10:58:55 -05:00
( unless org-persist--index ( org-persist--load-index ) )
2022-01-10 08:30:04 -05:00
( setq associated ( org-persist--normalize-associated associated ) )
( setq container ( org-persist--normalize-container container ) )
2022-06-01 22:56:45 -04:00
( unless ( and org-persist-disable-when-emacs-Q
;; FIXME: This is relying on undocumented fact that
;; Emacs sets `user-init-file' to nil when loaded with
;; "-Q" argument.
( not user-init-file ) )
( let* ( ( collection ( org-persist--find-index ` ( :container , container :associated , associated ) ) )
( persist-file
( when collection
( org-file-name-concat
org-persist-directory
( plist-get collection :persist-file ) ) ) )
( data nil ) )
( when ( and collection
( file-exists-p persist-file )
( or ( not ( plist-get collection :expiry ) ) ; current session
( not ( org-persist--gc-expired-p
( plist-get collection :expiry ) collection ) ) )
( or ( not hash-must-match )
( and ( plist-get associated :hash )
( equal ( plist-get associated :hash )
( plist-get ( plist-get collection :associated ) :hash ) ) ) ) )
( unless ( seq-find ( lambda ( v )
( run-hook-with-args-until-success 'org-persist-before-read-hook v associated ) )
( plist-get collection :container ) )
2022-06-20 21:35:01 -04:00
( setq data ( or ( gethash persist-file org-persist--write-cache )
( org-persist--read-elisp-file persist-file ) ) )
( when data
( cl-loop for container in ( plist-get collection :container )
with result = nil
do
( if load?
( push ( org-persist-load:generic container ( alist-get container data nil nil #' equal ) collection ) result )
( push ( org-persist-read:generic container ( alist-get container data nil nil #' equal ) collection ) result ) )
( run-hook-with-args 'org-persist-after-read-hook container associated )
finally return ( if ( = 1 ( length result ) ) ( car result ) result ) ) ) ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-load ( container &optional associated hash-must-match )
" Load CONTAINER data for ASSOCIATED.
The arguments have the same meaning as in ` org-persist-read '. "
( org-persist-read container associated hash-must-match t ) )
( defun org-persist-load-all ( &optional associated )
" Restore all the persistent data associated with ASSOCIATED. "
( unless org-persist--index ( org-persist--load-index ) )
( setq associated ( org-persist--normalize-associated associated ) )
( let ( all-containers )
( dolist ( collection org-persist--index )
( when collection
( cl-pushnew ( plist-get collection :container ) all-containers :test #' equal ) ) )
( dolist ( container all-containers )
2022-02-13 03:53:59 -05:00
( condition-case err
( org-persist-load container associated t )
( error
( message " %s. Deleting bad index entry. " err )
( org-persist--remove-from-index ( org-persist--find-index ` ( :container , container :associated , associated ) ) )
nil ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-load-all-buffer ( )
" Call `org-persist-load-all' in current buffer. "
( org-persist-load-all ( current-buffer ) ) )
2022-01-26 06:24:39 -05:00
( defun org-persist-write ( container &optional associated ignore-return )
2022-01-10 08:30:04 -05:00
" Save CONTAINER according to ASSOCIATED.
ASSOCIATED can be a plist, a buffer, or a string.
A buffer is treated as ( :buffer ASSOCIATED ) .
2022-01-25 21:09:40 -05:00
A string is treated as ( :file ASSOCIATED ) .
The return value is nil when writing fails and the written value ( as
2022-01-26 06:24:39 -05:00
returned by ` org-persist-read ' ) on success.
When IGNORE-RETURN is non-nil, just return t on success without calling
` org-persist-read '. "
2022-06-01 22:56:45 -04:00
( unless ( and org-persist-disable-when-emacs-Q
;; FIXME: This is relying on undocumented fact that
;; Emacs sets `user-init-file' to nil when loaded with
;; "-Q" argument.
( not user-init-file ) )
( setq associated ( org-persist--normalize-associated associated ) )
;; Update hash
( when ( and ( plist-get associated :file )
( plist-get associated :hash )
( get-file-buffer ( plist-get associated :file ) ) )
( setq associated ( org-persist--normalize-associated ( get-file-buffer ( plist-get associated :file ) ) ) ) )
( let ( ( collection ( org-persist--get-collection container associated ) ) )
( setf collection ( plist-put collection :associated associated ) )
2022-12-07 08:04:06 -05:00
( unless ( or
;; Prevent data leakage from encrypted files.
;; We do it in somewhat paranoid manner and do not
;; allow anything related to encrypted files to be
;; written.
( and ( plist-get associated :file )
( string-match-p epa-file-name-regexp ( plist-get associated :file ) ) )
( seq-find ( lambda ( v )
( run-hook-with-args-until-success 'org-persist-before-write-hook v associated ) )
( plist-get collection :container ) ) )
2022-06-01 22:56:45 -04:00
( when ( or ( file-exists-p org-persist-directory ) ( org-persist--save-index ) )
( let ( ( file ( org-file-name-concat org-persist-directory ( plist-get collection :persist-file ) ) )
( data ( mapcar ( lambda ( c ) ( cons c ( org-persist-write:generic c collection ) ) )
( plist-get collection :container ) ) ) )
2022-06-20 21:35:01 -04:00
( puthash file data org-persist--write-cache )
2022-06-28 21:06:12 -04:00
( org-persist--write-elisp-file file data )
2022-06-01 22:56:45 -04:00
( or ignore-return ( org-persist-read container associated ) ) ) ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-write-all ( &optional associated )
2022-01-14 22:53:59 -05:00
" Save all the persistent data.
When ASSOCIATED is non-nil, only save the matching data. "
2022-01-10 08:30:04 -05:00
( unless org-persist--index ( org-persist--load-index ) )
( setq associated ( org-persist--normalize-associated associated ) )
( let ( all-containers )
( dolist ( collection org-persist--index )
( if associated
( when collection
( cl-pushnew ( plist-get collection :container ) all-containers :test #' equal ) )
2022-02-13 03:53:59 -05:00
( condition-case err
( org-persist-write ( plist-get collection :container ) ( plist-get collection :associated ) t )
( error
( message " %s. Deleting bad index entry. " err )
( org-persist--remove-from-index collection )
nil ) ) ) )
2022-01-10 08:30:04 -05:00
( dolist ( container all-containers )
2022-02-13 03:53:59 -05:00
( let ( ( collection ( org-persist--find-index ` ( :container , container :associated , associated ) ) ) )
( when collection
( condition-case err
( org-persist-write container associated t )
( error
( message " %s. Deleting bad index entry. " err )
( org-persist--remove-from-index collection )
nil ) ) ) ) ) ) )
2022-01-10 08:30:04 -05:00
( defun org-persist-write-all-buffer ( )
" Call `org-persist-write-all' in current buffer.
Do nothing in an indirect buffer. "
( unless ( buffer-base-buffer ( current-buffer ) )
( org-persist-write-all ( current-buffer ) ) ) )
( defalias 'org-persist-gc:elisp #' ignore )
( defalias 'org-persist-gc:index #' ignore )
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( defalias 'org-persist-gc:version #' ignore )
( defalias 'org-persist-gc:file #' ignore )
( defalias 'org-persist-gc:url #' ignore )
2022-01-10 08:30:04 -05:00
2022-12-10 12:05:32 -05:00
( defun org-persist--gc-persist-file ( persist-file )
2022-01-10 08:30:04 -05:00
" Garbage collect PERSIST-FILE. "
2022-12-10 12:05:32 -05:00
( when ( file-exists-p persist-file )
( delete-file persist-file )
( when ( org-directory-empty-p ( file-name-directory persist-file ) )
( delete-directory ( file-name-directory persist-file ) ) ) ) )
2022-01-10 08:30:04 -05:00
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( defmacro org-persist-associated-files:generic ( container collection )
" List associated files in `org-persist-directory' of CONTAINER in COLLECTION. "
2022-12-10 12:37:11 -05:00
` ( let* ( ( c ( org-persist--normalize-container , container ) )
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( assocf-func-symbol ( intern ( format " org-persist-associated-files:%s " ( car c ) ) ) ) )
( if ( fboundp assocf-func-symbol )
( funcall assocf-func-symbol c , collection )
( error " org-persist: Read function %s not defined "
assocf-func-symbol ) ) ) )
( defalias 'org-persist-associated-files:elisp #' ignore )
( defalias 'org-persist-associated-files:index #' ignore )
( defalias 'org-persist-associated-files:version #' ignore )
2022-12-11 12:08:23 -05:00
( defun org-persist-associated-files:file ( container collection )
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
" List file CONTAINER associated files of COLLECTION in `org-persist-directory' . "
( let ( ( file ( org-persist-read container ( plist-get collection :associated ) ) ) )
( when ( file-exists-p file )
( list file ) ) ) )
( defun org-persist-associated-files:url ( container collection )
" List url CONTAINER associated files of COLLECTION in `org-persist-directory' . "
( let ( ( file ( org-persist-read container ( plist-get collection :associated ) ) ) )
( when ( file-exists-p file )
( list file ) ) ) )
2022-12-10 12:37:11 -05:00
2021-10-16 09:16:11 -04:00
( defun org-persist-gc ( )
2022-12-10 06:53:25 -05:00
" Remove expired or unregistered containers and orphaned files.
2022-01-10 08:30:04 -05:00
Also, remove containers associated with non-existing files. "
2022-06-01 22:56:45 -04:00
( unless ( and org-persist-disable-when-emacs-Q
;; FIXME: This is relying on undocumented fact that
;; Emacs sets `user-init-file' to nil when loaded with
;; "-Q" argument.
( not user-init-file ) )
2022-12-10 06:53:25 -05:00
( let ( new-index
( remote-files-num 0 )
( orphan-files
( delete ( org-file-name-concat org-persist-directory org-persist-index-file )
( directory-files-recursively org-persist-directory " .+ " ) ) ) )
2022-06-01 22:56:45 -04:00
( dolist ( collection org-persist--index )
( let* ( ( file ( plist-get ( plist-get collection :associated ) :file ) )
2022-12-10 10:55:11 -05:00
( web-file ( and file ( string-match-p " \\ ` https?:// " file ) ) )
2022-06-01 22:56:45 -04:00
( file-remote ( when file ( file-remote-p file ) ) )
( persist-file ( when ( plist-get collection :persist-file )
( org-file-name-concat
org-persist-directory
( plist-get collection :persist-file ) ) ) )
( expired? ( org-persist--gc-expired-p
( plist-get collection :expiry ) collection ) ) )
( when persist-file
2022-12-10 06:53:25 -05:00
( setq orphan-files ( delete persist-file orphan-files ) )
2022-12-10 10:55:11 -05:00
( when ( and file ( not web-file ) )
2022-06-01 22:56:45 -04:00
( when file-remote ( cl-incf remote-files-num ) )
( unless ( if ( not file-remote )
( file-exists-p file )
( pcase org-persist-remote-files
( 't t )
( 'check-existence
( file-exists-p file ) )
2022-06-04 04:28:07 -04:00
( ( pred numberp )
2022-12-10 11:02:04 -05:00
( < org-persist-remote-files remote-files-num ) )
2022-06-01 22:56:45 -04:00
( _ nil ) ) )
( setq expired? t ) ) )
( if expired?
( org-persist--gc-persist-file persist-file )
2022-12-10 12:37:11 -05:00
( push collection new-index )
( dolist ( container ( plist-get collection :container ) )
( dolist ( associated-file
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( org-persist-associated-files:generic
2022-12-10 12:37:11 -05:00
container collection ) )
org-persist: Use associated file functions for GC
* lisp/org-persist.el (org-persist-gc, org-persist--remove-from-index,
org-persist-gc:file, org-persist-gc:url, org-persist-gc:version,
org-persist-gc:url, org-persist-associated-files:generic,
org-persist-associated-files:url, org-persist-associated-files:elisp,
org-persist-associated-files:index,
org-persist-associated-files:version,
org-persist-associated-files:file): Use associated files for GC, and
move the associated files functions into the public
namespace (i.e. remove the double dash).
2022-12-10 13:49:26 -05:00
( setq orphan-files ( delete associated-file orphan-files ) ) ) ) ) ) ) )
2022-12-10 06:53:25 -05:00
( mapc #' org-persist--gc-persist-file orphan-files )
2022-06-01 22:56:45 -04:00
( setq org-persist--index ( nreverse new-index ) ) ) ) )
2021-10-16 09:16:11 -04:00
2021-10-19 08:17:27 -04:00
;; Automatically write the data, but only when we have write access.
( let ( ( dir ( directory-file-name
( file-name-as-directory org-persist-directory ) ) ) )
( while ( and ( not ( file-exists-p dir ) )
( not ( equal dir ( setq dir ( directory-file-name
( file-name-directory dir ) ) ) ) ) ) )
( if ( not ( file-writable-p dir ) )
( message " Missing write access rights to org-persist-directory: %S "
org-persist-directory )
2021-10-20 02:17:44 -04:00
( add-hook 'kill-emacs-hook #' org-persist-write-all )
Replace all uses of the old `defadvice` with the new `advice-add`
* lisp/org.el (org-run-like-in-org-mode): Strength reduce `eval`
to `cl-progv`.
(org--check-org-structure-template-alist): Strength reduce `eval`
to `symbol-value`.
(org-map-entries, org-eval-in-calendar, org-diary-sexp-entry):
Make sure we use the new lexically scoped dialect.
(org--math-always-on): New function, extracted from advice.
(org-cdlatex-mode): Use it with `advice-add`.
(org-self-insert-command): Simplify `and`+`listp` into `consp`.
(org-submit-bug-report):
Make sure we use the new lexically scoped dialect.
* lisp/org-protocol.el (org-protocol-convert-query-to-plist):
Use `cl-mapcan`.
(org--protocol-detect-protocol-server): New function, extracted
from advice.
(server-visit-files): Use it with `advice-add`.
* lisp/org-mouse.el (org--mouse-dnd-insert-text): New function, extracted
from advice.
(dnd-insert-text): Use it with `advice-add`.
(org--mouse-dnd-open-file): New function, extracted from advice.
(dnd-open-file): Use it with `advice-add`.
(org--mouse-open-at-point): New function, extracted from advice.
(org-mode-hook): Advise `org-open-at-point` with `advice-add`.
* lisp/org-ctags.el (org--ctags-load-tag-list): New function, extracted
from advice.
(visit-tags-table): Use it with `advice-add`.
(org--ctags-set-org-mark-before-finding-tag): New function, extracted
from advice.
(xref-find-definitions): Use it with `advice-add`.
* lisp/org-compat.el (org-bookmark-jump-unhide): Accept (unused) args.
(save-place-find-file-hook): Use `advice-add`.
(org--ecb-show-context): New function, extracted from advice.
(ecb-method-clicked): Use it with `advice-add`.
(org-mark-jump-unhide): Accept (unused) args.
(pop-to-mark-command, exchange-point-and-mark, pop-global-mark):
Use `advice-add`.
Along the way, remove some redundant `:group` args
(redundant because they specify the same group as would be used by
default anyway) and make a few other simplifications.
Also don't bother putting `advice-add` within an eval-after-load
since the advice machinery already takes care of handling it.
2022-04-01 01:50:01 -04:00
;; `org-persist-gc' should run before `org-persist-write-all'.
;; So we are adding the hook after `org-persist-write-all'.
2021-10-20 02:17:44 -04:00
( add-hook 'kill-emacs-hook #' org-persist-gc ) ) )
2021-10-19 08:17:27 -04:00
2022-01-10 08:30:04 -05:00
( add-hook 'after-init-hook #' org-persist-load-all )
2021-10-16 09:16:11 -04:00
( provide 'org-persist )
;;; org-persist.el ends here