mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-24 07:20:29 +00:00
Code

org-persist: Do not demand write access to existing directories

Browse Source 
* lisp/org-persist.el (org-persist--check-write-access): New function
checking write access to creating a directory and all the necessary
parents.  The function is a refactoring of duplicated code that
previously checked one parent beyond what needs to be created.
(org-persist-write:index): Use the new function.  Create
`org-persist-directory' together with all its parents.  Gracefully
handle failure.
* lisp/org-persist.el: Use the new function when adding hooks to
`kill-emacs-hook'.

Reported-by: Al Oomens <aloomens@outlook.com>
Link: https://list.orgmode.org/MW4PR19MB6888F37194BA260AE5631770C4332@MW4PR19MB6888.namprd19.prod.outlook.com
This commit is contained in:
Ihor Radchenko 2024-03-21 12:04:53 +03:00
parent 224254e7f0
commit ad02825337
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lisp/org-persist.el
View File

@ -857,22 +857,31 @@ COLLECTION is the plist holding data collection."
path)))
(format "%s-%s.%s" persist-file (md5 path) ext)))))
(defun org-persist--check-write-access (path)
"Check write access to all missing directories in PATH.
Show message and return nil if there is no write access.
Otherwise, return t."
(let* ((dir (directory-file-name (file-name-as-directory path)))
(prev dir))
(while (and (not (file-exists-p dir))
(setq prev dir)
(not (equal dir (setq dir (directory-file-name
(file-name-directory dir)))))))
(if (file-writable-p prev) t ; return t
(message "org-persist: Missing write access rights to: %S" prev)
;; return nil
nil)))
(defun org-persist-write:index (container _)
"Write index CONTAINER."
(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))))
(condition-case nil
(make-directory org-persist-directory 'parent)
(t
(warn "Failed to create org-persist storage in %s."
org-persist-directory)
(org-persist--check-write-access org-persist-directory))))
(when (file-exists-p org-persist-directory)
(let ((index-file
(org-file-name-concat org-persist-directory org-persist-index-file)))
@ -1294,19 +1303,12 @@ such scenario."
(make-temp-file "org-persist-" 'dir)))
;; 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)
(add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last.
(add-hook 'kill-emacs-hook #'org-persist-write-all)
;; `org-persist-gc' should run before `org-persist-write-all'.
;; So we are adding the hook after `org-persist-write-all'.
(add-hook 'kill-emacs-hook #'org-persist-gc)))
(when (org-persist--check-write-access org-persist-directory)
(add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last.
(add-hook 'kill-emacs-hook #'org-persist-write-all)
;; `org-persist-gc' should run before `org-persist-write-all'.
;; So we are adding the hook after `org-persist-write-all'.
(add-hook 'kill-emacs-hook #'org-persist-gc))
(add-hook 'after-init-hook #'org-persist-load-all)