diff options
author | Gustav Wikström <gustav@whil.se> | 2019-09-02 23:15:13 +0200 |
---|---|---|
committer | Gustav Wikström <gustav@whil.se> | 2019-09-02 23:15:13 +0200 |
commit | 4b7eda1a2f3e078ead8d10160fea7089761a044c (patch) | |
tree | a957fc4fe72fa95a71887db6345570d8a0e78ed8 | |
parent | dea0c70c7b9036f386d36dfc8864ac0e431f9d25 (diff) | |
download | org-mode-4b7eda1a2f3e078ead8d10160fea7089761a044c.tar.gz |
org-attach, test-org-attach: Restore fs check in org-attach-dir
In commit ae9cd4370 the filsystem check for org-attach-dir was
removed. Adding it back here, together with an optional flag to
override the check.
To satisfy compatabilty issues with org-brain. Ref. thread here:
- https://github.com/Kungsgeten/org-brain/pull/203
-rw-r--r-- | lisp/org-attach.el | 17 | ||||
-rw-r--r-- | testing/lisp/test-org-attach.el | 10 |
2 files changed, 20 insertions, 7 deletions
diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 1c96228..2138a28 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -200,7 +200,7 @@ you added attachments yourself.\n") ((?O) org-attach-open-in-emacs "Like \"o\", but force opening in Emacs.") ((?f ?\C-f) org-attach-reveal - "Open current node's attachment directory. Create if not exist.") + "Open current node's attachment directory. Create if missing.") ((?F) org-attach-reveal-in-emacs "Like \"f\", but force using Dired in Emacs.\n") ((?d ?\C-d) org-attach-delete-one @@ -233,7 +233,7 @@ Each entry in this list is a list of three elements: "The dispatcher for attachment commands. Shows a list of commands and prompts for another key to execute a command." (interactive) - (let ((dir (org-attach-dir)) + (let ((dir (org-attach-dir nil 'no-fs-check)) c marker) (when (eq major-mode 'org-agenda-mode) (setq marker (or (get-text-property (point) 'org-hd-marker) @@ -285,7 +285,7 @@ Shows a list of commands and prompts for another key to execute a command." (call-interactively command) (error "No such attachment command: %c" c)))))) -(defun org-attach-dir (&optional create-if-not-exists-p) +(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check) "Return the directory associated with the current outline node. First check for DIR property, then ID property. `org-attach-use-inheritance' determines whether inherited @@ -297,7 +297,9 @@ Note that this method returns the directory as declared by ID or DIR even if the directory doesn't exist in the filesystem. If CREATE-IF-NOT-EXIST-P is non-nil, `org-attach-dir-get-create' -is run. +is run. If NO-FS-CHECK is non-nil, the function returns the path +to the attachment even if it has not yet been initialized in the +filesystem. If no attachment directory exist, return nil." (let (attach-dir id) @@ -313,7 +315,10 @@ If no attachment directory exist, return nil." ((setq id (org-entry-get nil "ID" org-attach-use-inheritance)) (org-attach-check-absolute-path nil) (setq attach-dir (org-attach-dir-from-id id)))) - attach-dir)) + (if no-fs-check + attach-dir + (when (and attach-dir (file-directory-p attach-dir)) + attach-dir)))) (defun org-attach-dir-get-create () "Return existing or new directory associated with the current outline node. @@ -322,7 +327,7 @@ directory if neither ID nor DIR property exist. If the attachment by some reason cannot be created an error will be raised." (interactive) - (let ((attach-dir (org-attach-dir))) + (let ((attach-dir (org-attach-dir nil 'no-fs-check))) (unless attach-dir (let (answer) (when (eq org-attach-preferred-new-method 'ask) diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el index 5bcfe86..324e51c 100644 --- a/testing/lisp/test-org-attach.el +++ b/testing/lisp/test-org-attach.el @@ -80,12 +80,20 @@ (org-test-in-example-file org-test-attachments-file (goto-char 336) ;; H3 (org-attach-file-list (org-attach-dir))))) + ;; Test for folder not initialized in the filesystem + (should-not (org-test-in-example-file org-test-attachments-file + (goto-char 401) ;; H3.1 + (let ((org-attach-use-inheritance nil) + (org-attach-id-dir "data/")) + (org-attach-dir)))) + ;; Not yet initialized folder should be found if no-fs-check is + ;; non-nil (should (equal "data/ab/cd12345" (org-test-in-example-file org-test-attachments-file (goto-char 401) ;; H3.1 (let ((org-attach-use-inheritance nil) (org-attach-id-dir "data/")) - (file-relative-name (org-attach-dir)))))) + (file-relative-name (org-attach-dir nil t)))))) (should (equal '("fileA" "fileB") (org-test-in-example-file org-test-attachments-file (goto-char 401) ;; H3.1 |