[elpa] externals/org 6933c1a 01/29: lisp/org-persist.el: New library to store data across sessions

[ELPA Syncer]

branch: externals/org
commit 6933c1ad78088a5d34237f69868962483319b824
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>

    lisp/org-persist.el: New library to store data across sessions
---
 lisp/org-persist.el | 262 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 262 insertions(+)

diff --git a/lisp/org-persist.el b/lisp/org-persist.el
new file mode 100644
index 0000000..1de4b4b
--- /dev/null
+++ b/lisp/org-persist.el
@@ -0,0 +1,262 @@
+;;; org-persist.el --- Persist data across Emacs sessions         -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2021 Free Software Foundation, Inc.
+
+;; 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:
+;;
+;; This file implements persistant data storage across Emacs sessions.
+;; Both global and buffer-local data can be stored.
+
+;;; Code:
+
+(require 'org-compat)
+(require 'org-id)
+
+(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))
+
+(defvar org-persist-path (org-file-name-concat user-emacs-directory 
"org-persist/")
+  "Directory where the data is stored.")
+
+(defvar org-persist-index-file "index"
+  "File name used to store the data index.")
+
+(defvar org-persist-before-write-hook nil
+  "Abnormal hook ran before saving data for a single variable in a buffer.
+The hook must accept the same arguments as `org-persist-write'.
+The hooks will be evaluated until a hook returns non-nil.
+If any of the hooks return non-nil, do not save the data.")
+
+(defvar org-persist-before-read-hook nil
+  "Abnormal hook ran before reading data for a single variable in a buffer.
+The hook must accept the same arguments as `org-persist-read'.
+The hooks will be evaluated until a hook returns non-nil.
+If any of the hooks return non-nil, do not read the data.")
+
+(defvar org-persist-after-read-hook nil
+  "Abnormal hook ran after reading data for a single variable in a buffer.
+The hook must accept the same arguments as `org-persist-read'.")
+
+(defvar org-persist--index nil
+  "Global index.
+
+The index is a list of plists.  Each plist contains information about
+a data variable.  Each plist contains the following properties:
+
+  - `:variable'    list of variables to be stored in single file
+  - `:persist-file': data file name
+  - `:path':       buffer file path, if any
+  - `:inode':      buffer file inode, if any
+  - `:hash':       buffer hash, if any")
+
+(defun org-persist--get-index (var &optional buffer)
+  "Return plist used to store VAR in BUFFER.
+When BUFFER is nil, return plist for global VAR."
+  (let* ((buffer-file (when buffer (buffer-file-name (or (buffer-base-buffer 
buffer)
+                                                         buffer))))
+         (inode (when buffer-file (file-attribute-inode-number 
(file-attributes buffer-file)))))
+    (let ((result (seq-find (lambda (plist)
+                              (and (or (memq var (plist-get plist :variable))
+                                       (eq var (plist-get plist :variable)))
+                                   (or (equal inode (plist-get plist :inode))
+                                       (equal buffer-file (plist-get plist 
:path)))))
+                            org-persist--index)))
+      (when result
+        (unless (equal buffer-file (plist-get result :path))
+          (setf result (plist-put result :path buffer-file))))
+      (unless result
+        (push (list :variable (if (listp var) var (list var))
+                    :persist-file (replace-regexp-in-string "^.." "\\&/" 
(org-id-uuid))
+                    :path buffer-file
+                    :inode inode
+                    :hash (when buffer (secure-hash 'md5 buffer)))
+              org-persist--index)
+        (setf result (car org-persist--index)))
+      result)))
+
+(defun org-persist--read-index ()
+  "Read `org-persist--index'"
+  (unless org-persist--index
+    (when (file-exists-p (org-file-name-concat org-persist-path 
org-persist-index-file))
+      (with-temp-buffer
+        (insert-file-contents (org-file-name-concat org-persist-path 
org-persist-index-file))
+        (setq org-persist--index (read (current-buffer)))))))
+
+(cl-defun org-persist-register (var &optional buffer &key inherit)
+  "Register VAR in BUFFER to be persistent.
+Optional key INHERIT make VAR dependent on another variable.  Such
+dependency means that data shared between variables will be preserved
+(see elisp#Circular Objects)."
+  (unless org-persist--index (org-persist--read-index))
+  (when inherit
+    (let ((inherited-index (org-persist--get-index inherit buffer)))
+      (unless (memq var (plist-get inherited-index :variable))
+        (push var (plist-get inherited-index :variable)))))
+  (org-persist--get-index var buffer)
+  (when buffer
+    (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer 1000 'local)))
+
+(defun org-persist-unregister (var &optional buffer)
+  "Unregister VAR in BUFFER to be persistent.
+When BUFFER is `all', unregister VAR in all buffers."
+  (unless org-persist--index (org-persist--read-index))
+  (setq org-persist--index
+        (seq-remove
+         (lambda (plist)
+           (when (and (memq var (plist-get plist :variable))
+                      (or (eq buffer 'all)
+                          (eq (buffer-file-name
+                               (or (buffer-base-buffer buffer)
+                                   buffer))
+                              (plist-get plist :path))))
+             (if (length> (plist-get plist :variable) 1)
+                 (progn
+                   (setq plist
+                         (plist-put plist :variable
+                                    (delq var (plist-get plist :variable))))
+                   ;; Do not remove the index though.
+                   nil)
+               (let ((persist-file (org-file-name-concat org-persist-path 
(plist-get plist :persist-file))))
+                 (delete-file persist-file)
+                 (when (directory-empty-p (file-name-directory persist-file))
+                   (delete-directory (file-name-directory persist-file))))
+               'delete-from-index)))
+         org-persist--index))
+  (org-persist-gc))
+
+(defun org-persist-write (var &optional buffer)
+  "Save buffer-local data in BUFFER for VAR."
+  (unless (and buffer (not (get-buffer buffer)))
+    (unless (listp var) (setq var (list var)))
+    (with-current-buffer (or buffer (current-buffer))
+      (let ((index (org-persist--get-index var buffer)))
+        (setf index (plist-put index :hash (when buffer (secure-hash 'md5 
buffer))))
+        (let ((print-circle t)
+              print-level
+              print-length
+              print-quoted
+              (print-escape-control-characters t)
+              (print-escape-nonascii t)
+              (print-continuous-numbering t)
+              print-number-table)
+          (unless (seq-find (lambda (v)
+                              (run-hook-with-args-until-success 
'org-persist-before-write-hook v buffer))
+                            (plist-get index :variable))
+            (unless (file-exists-p org-persist-path)
+              (make-directory org-persist-path))
+            (with-temp-file (org-file-name-concat org-persist-path 
org-persist-index-file)
+              (prin1 org-persist--index (current-buffer)))
+            (let ((file (org-file-name-concat org-persist-path (plist-get 
index :persist-file)))
+                  (data (mapcar (lambda (s) (cons s (symbol-value s)))
+                                (plist-get index :variable))))
+              (unless (file-exists-p (file-name-directory file))
+                (make-directory (file-name-directory file) t))
+              (with-temp-file file
+                (prin1 data (current-buffer))))))))))
+
+(defun org-persist-write-all (&optional buffer)
+  "Save all the persistent data."
+  (dolist (index org-persist--index)
+    (when (or (not (plist-get index :path))
+              (and (get-file-buffer (plist-get index :path))
+                   (or (not buffer)
+                       (equal (buffer-file-name (or (buffer-base-buffer buffer)
+                                                    buffer))
+                              (plist-get index :path)))))
+      (org-persist-write (plist-get index :variable)
+              (when (plist-get index :path)
+                (get-file-buffer (plist-get index :path)))))))
+
+(defun org-persist-write-all-buffer ()
+  "Call `org-persist-write-all' in current buffer."
+  (org-persist-write-all (current-buffer)))
+
+(defun org-persist-read (var &optional buffer)
+  "Restore VAR data in BUFFER."
+  (let* ((index (org-persist--get-index var buffer))
+         (persist-file (org-file-name-concat org-persist-path (plist-get index 
:persist-file)))
+         (data nil))
+    (when (and (file-exists-p persist-file)
+               (or (not buffer)
+                   (equal (secure-hash 'md5 buffer) (plist-get index :hash))))
+      (unless (seq-find (lambda (v)
+                          (run-hook-with-args-until-success 
'org-persist-before-read-hook v buffer))
+                        (plist-get index :variable))
+        (with-temp-buffer
+          (let ((coding-system-for-read 'utf-8)
+                (read-circle t))
+            (insert-file-contents persist-file))
+          ;; FIXME: Reading sometimes fails to read circular objects.
+          ;; I suspect that it happens when we have object reference
+          ;; #N# read before object definition #N=.  If it is really
+          ;; #so, it should be Emacs bug - either in `read' or in
+          ;; #`prin1'.  Meanwhile, just fail silently when `read'
+          ;; #fails to parse the saved cache object.
+          (condition-case err
+              (setq data (read (current-buffer)))
+            (error
+             (warn "Emacs reader failed to read data for %S:%S. The error was: 
%S"
+                   (or buffer "global") var (error-message-string err))
+             (setq data nil))))
+        (with-current-buffer (or buffer (current-buffer))
+          (cl-loop for var1 in (plist-get index :variable)
+                   do
+                   (when (alist-get var1 data)
+                     (setf (symbol-value var1) (alist-get var1 data)))
+                   (run-hook-with-args 'org-persist-after-read-hook var1 
buffer)))))))
+
+(defun org-persist-read-all (&optional buffer)
+  "Restore all the persistent data in BUFFER."
+  (unless org-persist--index (org-persist--read-index))
+  (dolist (index org-persist--index)
+    (when (equal (buffer-file-name (or (buffer-base-buffer buffer)
+                                       buffer))
+                 (plist-get index :path))
+      (org-persist-read (plist-get index :variable) buffer))))
+
+(defun org-persist-read-all-buffer ()
+  "Call `org-persist-read-all' in current buffer."
+  (org-persist-read-all (current-buffer)))
+
+(defun org-persist-gc ()
+  "Remove stored data for not existing files or unregistered variables."
+  (let (new-index)
+    (dolist (index org-persist--index)
+      (when-let ((file (plist-get index :path))
+                 (persist-file (org-file-name-concat
+                                org-persist-path
+                                (plist-get index :persist-file))))
+        (if (file-exists-p file)
+            (push index new-index)
+          (when (file-exists-p persist-file)
+            (delete-file persist-file)
+            (when (directory-empty-p (file-name-directory persist-file))
+              (delete-directory (file-name-directory persist-file)))))))
+    (setq org-persist--index (nreverse new-index))))
+
+(add-hook 'kill-emacs-hook #'org-persist-gc)
+(add-hook 'kill-emacs-hook #'org-persist-write-all 1000)
+(add-hook 'after-init-hook #'org-persist-read-all)
+
+(provide 'org-persist)
+
+;;; org-persist.el ends here