org-persist.el 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286
  1. ;;; org-persist.el --- Persist data across Emacs sessions -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2021-2021 Free Software Foundation, Inc.
  3. ;; Author: Ihor Radchenko <yantar92 at gmail dot com>
  4. ;; Keywords: cache, storage
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;
  18. ;; This file implements persistant data storage across Emacs sessions.
  19. ;; Both global and buffer-local data can be stored.
  20. ;;; Code:
  21. (require 'org-compat)
  22. (require 'org-id)
  23. (require 'xdg)
  24. (declare-function org-back-to-heading "org" (&optional invisible-ok))
  25. (declare-function org-next-visible-heading "org" (arg))
  26. (declare-function org-at-heading-p "org" (&optional invisible-not-ok))
  27. (defvar org-persist-directory (expand-file-name
  28. (org-file-name-concat
  29. (let ((cache-dir (xdg-cache-home)))
  30. (if (seq-empty-p cache-dir)
  31. user-emacs-directory
  32. cache-dir))
  33. "org-persist/"))
  34. "Directory where the data is stored.")
  35. (defvar org-persist-index-file "index"
  36. "File name used to store the data index.")
  37. (defvar org-persist-before-write-hook nil
  38. "Abnormal hook ran before saving data for a single variable in a buffer.
  39. The hook must accept the same arguments as `org-persist-write'.
  40. The hooks will be evaluated until a hook returns non-nil.
  41. If any of the hooks return non-nil, do not save the data.")
  42. (defvar org-persist-before-read-hook nil
  43. "Abnormal hook ran before reading data for a single variable in a buffer.
  44. The hook must accept the same arguments as `org-persist-read'.
  45. The hooks will be evaluated until a hook returns non-nil.
  46. If any of the hooks return non-nil, do not read the data.")
  47. (defvar org-persist-after-read-hook nil
  48. "Abnormal hook ran after reading data for a single variable in a buffer.
  49. The hook must accept the same arguments as `org-persist-read'.")
  50. (defvar org-persist--index nil
  51. "Global index.
  52. The index is a list of plists. Each plist contains information about
  53. a data variable. Each plist contains the following properties:
  54. - `:variable' list of variables to be stored in single file
  55. - `:persist-file': data file name
  56. - `:path': buffer file path, if any
  57. - `:inode': buffer file inode, if any
  58. - `:hash': buffer hash, if any")
  59. (defun org-persist--get-index (var &optional buffer)
  60. "Return plist used to store VAR in BUFFER.
  61. When BUFFER is nil, return plist for global VAR."
  62. (org-persist--read-index)
  63. (let* ((buffer-file (when buffer (buffer-file-name (or (buffer-base-buffer buffer)
  64. buffer))))
  65. (inode (when buffer-file (file-attribute-inode-number (file-attributes buffer-file)))))
  66. (let ((result (seq-find (lambda (plist)
  67. (and (or (memq var (plist-get plist :variable))
  68. (eq var (plist-get plist :variable)))
  69. (or (equal inode (plist-get plist :inode))
  70. (equal buffer-file (plist-get plist :path)))))
  71. org-persist--index)))
  72. (when result
  73. (unless (equal buffer-file (plist-get result :path))
  74. (setf result (plist-put result :path buffer-file))))
  75. (unless result
  76. (push (list :variable (if (listp var) var (list var))
  77. :persist-file (replace-regexp-in-string "^.." "\\&/" (org-id-uuid))
  78. :path buffer-file
  79. :inode inode
  80. :hash (when buffer (secure-hash 'md5 buffer)))
  81. org-persist--index)
  82. (setf result (car org-persist--index)))
  83. result)))
  84. (defun org-persist--read-index ()
  85. "Read `org-persist--index'"
  86. (unless org-persist--index
  87. (if (file-exists-p (org-file-name-concat org-persist-directory org-persist-index-file))
  88. (with-temp-buffer
  89. (insert-file-contents (org-file-name-concat org-persist-directory org-persist-index-file))
  90. (setq org-persist--index (read (current-buffer))))
  91. (warn "Cannot read org-persist index from %s."
  92. (org-file-name-concat org-persist-directory org-persist-index-file)))))
  93. (cl-defun org-persist-register (var &optional buffer &key inherit)
  94. "Register VAR in BUFFER to be persistent.
  95. Optional key INHERIT make VAR dependent on another variable. Such
  96. dependency means that data shared between variables will be preserved
  97. (see elisp#Circular Objects)."
  98. (unless org-persist--index (org-persist--read-index))
  99. (when inherit
  100. (let ((inherited-index (org-persist--get-index inherit buffer)))
  101. (unless (memq var (plist-get inherited-index :variable))
  102. (setq inherited-index
  103. (plist-put inherited-index :variable
  104. (cons var (plist-get inherited-index :variable)))))))
  105. (org-persist--get-index var buffer)
  106. (when buffer
  107. (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer 1000 'local)))
  108. (defun org-persist-unregister (var &optional buffer)
  109. "Unregister VAR in BUFFER to be persistent.
  110. When BUFFER is `all', unregister VAR in all buffers."
  111. (unless org-persist--index (org-persist--read-index))
  112. (setq org-persist--index
  113. (seq-remove
  114. (lambda (plist)
  115. (when (and (memq var (plist-get plist :variable))
  116. (or (eq buffer 'all)
  117. (eq (buffer-file-name
  118. (or (buffer-base-buffer buffer)
  119. buffer))
  120. (plist-get plist :path))))
  121. (if (> (length (plist-get plist :variable)) 1)
  122. (progn
  123. (setq plist
  124. (plist-put plist :variable
  125. (delq var (plist-get plist :variable))))
  126. ;; Do not remove the index though.
  127. nil)
  128. (let ((persist-file (org-file-name-concat org-persist-directory (plist-get plist :persist-file))))
  129. (delete-file persist-file)
  130. (when (org-directory-empty-p (file-name-directory persist-file))
  131. (delete-directory (file-name-directory persist-file))))
  132. 'delete-from-index)))
  133. org-persist--index))
  134. (org-persist-gc))
  135. (defun org-persist-write (var &optional buffer)
  136. "Save buffer-local data in BUFFER for VAR."
  137. (unless (and buffer (not (get-buffer buffer)))
  138. (unless (listp var) (setq var (list var)))
  139. (with-current-buffer (or buffer (current-buffer))
  140. (let ((index (org-persist--get-index var buffer)))
  141. (setf index (plist-put index :hash (when buffer (secure-hash 'md5 buffer))))
  142. (let ((print-circle t)
  143. print-level
  144. print-length
  145. print-quoted
  146. (print-escape-control-characters t)
  147. (print-escape-nonascii t)
  148. (print-continuous-numbering t)
  149. print-number-table)
  150. (unless (seq-find (lambda (v)
  151. (run-hook-with-args-until-success 'org-persist-before-write-hook v buffer))
  152. (plist-get index :variable))
  153. (unless (file-exists-p org-persist-directory)
  154. (make-directory org-persist-directory))
  155. (unless (file-exists-p org-persist-directory)
  156. (warn "Failed to create org-persist storage in %s."
  157. org-persist-directory)
  158. (let ((dir (directory-file-name
  159. (file-name-as-directory org-persist-directory))))
  160. (while (and (not (file-exists-p dir))
  161. (not (equal dir (setq dir (directory-file-name
  162. (file-name-directory dir)))))))
  163. (unless (file-writable-p dir)
  164. (message "Missing write access rights to org-persist-directory: %S"
  165. org-persist-directory))))
  166. (with-temp-file (org-file-name-concat org-persist-directory org-persist-index-file)
  167. (prin1 org-persist--index (current-buffer)))
  168. (let ((file (org-file-name-concat org-persist-directory (plist-get index :persist-file)))
  169. (data (mapcar (lambda (s) (cons s (symbol-value s)))
  170. (plist-get index :variable))))
  171. (unless (file-exists-p (file-name-directory file))
  172. (make-directory (file-name-directory file) t))
  173. (with-temp-file file
  174. (prin1 data (current-buffer))))))))))
  175. (defun org-persist-write-all (&optional buffer)
  176. "Save all the persistent data."
  177. (dolist (index org-persist--index)
  178. (when (or (not (plist-get index :path))
  179. (and (get-file-buffer (plist-get index :path))
  180. (or (not buffer)
  181. (equal (buffer-file-name (or (buffer-base-buffer buffer)
  182. buffer))
  183. (plist-get index :path)))))
  184. (org-persist-write (plist-get index :variable)
  185. (when (plist-get index :path)
  186. (get-file-buffer (plist-get index :path)))))))
  187. (defun org-persist-write-all-buffer ()
  188. "Call `org-persist-write-all' in current buffer."
  189. (org-persist-write-all (current-buffer)))
  190. (defun org-persist-read (var &optional buffer)
  191. "Restore VAR data in BUFFER."
  192. (let* ((index (org-persist--get-index var buffer))
  193. (persist-file (org-file-name-concat org-persist-directory (plist-get index :persist-file)))
  194. (data nil))
  195. (when (and (file-exists-p persist-file)
  196. (or (not buffer)
  197. (equal (secure-hash 'md5 buffer) (plist-get index :hash))))
  198. (unless (seq-find (lambda (v)
  199. (run-hook-with-args-until-success 'org-persist-before-read-hook v buffer))
  200. (plist-get index :variable))
  201. (with-temp-buffer
  202. (let ((coding-system-for-read 'utf-8)
  203. (read-circle t))
  204. (insert-file-contents persist-file))
  205. ;; FIXME: Reading sometimes fails to read circular objects.
  206. ;; I suspect that it happens when we have object reference
  207. ;; #N# read before object definition #N=. If it is really
  208. ;; so, it should be Emacs bug - either in `read' or in
  209. ;; `prin1'. Meanwhile, just fail silently when `read'
  210. ;; fails to parse the saved cache object.
  211. (condition-case err
  212. (setq data (read (current-buffer)))
  213. (error
  214. (warn "Emacs reader failed to read data for %S:%S. The error was: %S"
  215. (or buffer "global") var (error-message-string err))
  216. (setq data nil))))
  217. (with-current-buffer (or buffer (current-buffer))
  218. (cl-loop for var1 in (plist-get index :variable)
  219. do
  220. (when (alist-get var1 data)
  221. (setf (symbol-value var1) (alist-get var1 data)))
  222. (run-hook-with-args 'org-persist-after-read-hook var1 buffer)))))))
  223. (defun org-persist-read-all (&optional buffer)
  224. "Restore all the persistent data in BUFFER."
  225. (unless org-persist--index (org-persist--read-index))
  226. (dolist (index org-persist--index)
  227. (when (equal (buffer-file-name (or (buffer-base-buffer buffer)
  228. buffer))
  229. (plist-get index :path))
  230. (org-persist-read (plist-get index :variable) buffer))))
  231. (defun org-persist-read-all-buffer ()
  232. "Call `org-persist-read-all' in current buffer."
  233. (org-persist-read-all (current-buffer)))
  234. (defun org-persist-gc ()
  235. "Remove stored data for not existing files or unregistered variables."
  236. (let (new-index)
  237. (dolist (index org-persist--index)
  238. (let ((file (plist-get index :path))
  239. (persist-file (org-file-name-concat
  240. org-persist-directory
  241. (plist-get index :persist-file))))
  242. (when (and file persist-file)
  243. (if (file-exists-p file)
  244. (push index new-index)
  245. (when (file-exists-p persist-file)
  246. (delete-file persist-file)
  247. (when (org-directory-empty-p (file-name-directory persist-file))
  248. (delete-directory (file-name-directory persist-file))))))))
  249. (setq org-persist--index (nreverse new-index))))
  250. (add-hook 'kill-emacs-hook #'org-persist-gc)
  251. (add-hook 'kill-emacs-hook #'org-persist-write-all 100)
  252. (add-hook 'after-init-hook #'org-persist-read-all)
  253. (provide 'org-persist)
  254. ;;; org-persist.el ends here