瀏覽代碼

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
Gustav Wikström 5 年之前
父節點
當前提交
4b7eda1a2f
共有 2 個文件被更改,包括 20 次插入7 次删除
  1. 11 6
      lisp/org-attach.el
  2. 9 1
      testing/lisp/test-org-attach.el

+ 11 - 6
lisp/org-attach.el

@@ -200,7 +200,7 @@ you added attachments yourself.\n")
     ((?O) org-attach-open-in-emacs
     ((?O) org-attach-open-in-emacs
      "Like \"o\", but force opening in Emacs.")
      "Like \"o\", but force opening in Emacs.")
     ((?f ?\C-f) org-attach-reveal
     ((?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
     ((?F) org-attach-reveal-in-emacs
      "Like \"f\", but force using Dired in Emacs.\n")
      "Like \"f\", but force using Dired in Emacs.\n")
     ((?d ?\C-d) org-attach-delete-one
     ((?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.
   "The dispatcher for attachment commands.
 Shows a list of commands and prompts for another key to execute a command."
 Shows a list of commands and prompts for another key to execute a command."
   (interactive)
   (interactive)
-  (let ((dir (org-attach-dir))
+  (let ((dir (org-attach-dir nil 'no-fs-check))
 	c marker)
 	c marker)
     (when (eq major-mode 'org-agenda-mode)
     (when (eq major-mode 'org-agenda-mode)
       (setq marker (or (get-text-property (point) 'org-hd-marker)
       (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)
 	    (call-interactively command)
 	  (error "No such attachment command: %c" c))))))
 	  (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.
   "Return the directory associated with the current outline node.
 First check for DIR property, then ID property.
 First check for DIR property, then ID property.
 `org-attach-use-inheritance' determines whether inherited
 `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.
 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'
 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."
 If no attachment directory exist, return nil."
   (let (attach-dir id)
   (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))
      ((setq id (org-entry-get nil "ID" org-attach-use-inheritance))
       (org-attach-check-absolute-path nil)
       (org-attach-check-absolute-path nil)
       (setq attach-dir (org-attach-dir-from-id id))))
       (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 ()
 (defun org-attach-dir-get-create ()
   "Return existing or new directory associated with the current outline node.
   "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."
 If the attachment by some reason cannot be created an error will be raised."
   (interactive)
   (interactive)
-  (let ((attach-dir (org-attach-dir)))
+  (let ((attach-dir (org-attach-dir nil 'no-fs-check)))
     (unless attach-dir
     (unless attach-dir
       (let (answer)
       (let (answer)
 	(when (eq org-attach-preferred-new-method 'ask)
 	(when (eq org-attach-preferred-new-method 'ask)

+ 9 - 1
testing/lisp/test-org-attach.el

@@ -80,12 +80,20 @@
 		  (org-test-in-example-file org-test-attachments-file
 		  (org-test-in-example-file org-test-attachments-file
 		    (goto-char 336) ;; H3
 		    (goto-char 336) ;; H3
 		    (org-attach-file-list (org-attach-dir)))))
 		    (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"
   (should (equal "data/ab/cd12345"
 		 (org-test-in-example-file org-test-attachments-file
 		 (org-test-in-example-file org-test-attachments-file
 		   (goto-char 401) ;; H3.1
 		   (goto-char 401) ;; H3.1
 		   (let ((org-attach-use-inheritance nil)
 		   (let ((org-attach-use-inheritance nil)
 			 (org-attach-id-dir "data/"))
 			 (org-attach-id-dir "data/"))
-		     (file-relative-name (org-attach-dir))))))
+		     (file-relative-name (org-attach-dir nil t))))))
   (should (equal '("fileA" "fileB")
   (should (equal '("fileA" "fileB")
 		 (org-test-in-example-file org-test-attachments-file
 		 (org-test-in-example-file org-test-attachments-file
 		   (goto-char 401) ;; H3.1
 		   (goto-char 401) ;; H3.1