Bladeren bron

Prevent export to file from overwriting current file

* lisp/ox.el (org-export-output-file-name): Add a protection when
  output file name is the same as the original org.
* testing/lisp/test-ox.el: Add tests.
Nicolas Goaziou 12 jaren geleden
bovenliggende
commit
a8e48bd3a8
2 gewijzigde bestanden met toevoegingen van 75 en 32 verwijderingen
  1. 38 32
      lisp/ox.el
  2. 37 0
      testing/lisp/test-ox.el

+ 38 - 32
lisp/ox.el

@@ -2962,38 +2962,44 @@ directory.
 When optional argument VISIBLE-ONLY is non-nil, don't export
 contents of hidden elements.
 
-Return file name as a string, or nil if it couldn't be
-determined."
-  (let ((base-name
-	 ;; File name may come from EXPORT_FILE_NAME subtree property,
-	 ;; assuming point is at beginning of said sub-tree.
-	 (file-name-sans-extension
-	  (or (and subtreep
-		   (org-entry-get
-		    (save-excursion
-		      (ignore-errors (org-back-to-heading) (point)))
-		    "EXPORT_FILE_NAME" t))
-	      ;; File name may be extracted from buffer's associated
-	      ;; file, if any.
-	      (let ((visited-file (buffer-file-name (buffer-base-buffer))))
-		(and visited-file (file-name-nondirectory visited-file)))
-	      ;; Can't determine file name on our own: Ask user.
-	      (let ((read-file-name-function
-		     (and org-completion-use-ido 'ido-read-file-name)))
-		(read-file-name
-		 "Output file: " pub-dir nil nil nil
-		 (lambda (name)
-		   (string= (file-name-extension name t) extension))))))))
-    ;; Build file name.  Enforce EXTENSION over whatever user may have
-    ;; come up with.  PUB-DIR, if defined, always has precedence over
-    ;; any provided path.
-    (cond
-     (pub-dir
-      (concat (file-name-as-directory pub-dir)
-	      (file-name-nondirectory base-name)
-	      extension))
-     ((file-name-absolute-p base-name) (concat base-name extension))
-     (t (concat (file-name-as-directory ".") base-name extension)))))
+Return file name as a string."
+  (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
+	 (base-name
+	  ;; File name may come from EXPORT_FILE_NAME subtree
+	  ;; property, assuming point is at beginning of said
+	  ;; sub-tree.
+	  (file-name-sans-extension
+	   (or (and subtreep
+		    (org-entry-get
+		     (save-excursion
+		       (ignore-errors (org-back-to-heading) (point)))
+		     "EXPORT_FILE_NAME" t))
+	       ;; File name may be extracted from buffer's associated
+	       ;; file, if any.
+	       (and visited-file (file-name-nondirectory visited-file))
+	       ;; Can't determine file name on our own: Ask user.
+	       (let ((read-file-name-function
+		      (and org-completion-use-ido 'ido-read-file-name)))
+		 (read-file-name
+		  "Output file: " pub-dir nil nil nil
+		  (lambda (name)
+		    (string= (file-name-extension name t) extension)))))))
+	 (output-file
+	  ;; Build file name.  Enforce EXTENSION over whatever user
+	  ;; may have come up with.  PUB-DIR, if defined, always has
+	  ;; precedence over any provided path.
+	  (cond
+	   (pub-dir
+	    (concat (file-name-as-directory pub-dir)
+		    (file-name-nondirectory base-name)
+		    extension))
+	   ((file-name-absolute-p base-name) (concat base-name extension))
+	   (t (concat (file-name-as-directory ".") base-name extension)))))
+    ;; If writing to OUTPUT-FILE would overwrite original file, append
+    ;; EXTENSION another time to final name.
+    (if (and visited-file (file-equal-p visited-file output-file))
+	(concat output-file extension)
+      output-file)))
 
 (defun org-export-expand-include-keyword (&optional included dir)
   "Expand every include keyword in buffer.

+ 37 - 0
testing/lisp/test-ox.el

@@ -421,6 +421,43 @@ text
       (should (equal (org-export-as 'test nil nil 'body-only) "Text\n"))
       (should (equal (org-export-as 'test) "BEGIN\nText\nEND")))))
 
+(ert-deftest test-org-export/output-file-name ()
+  "Test `org-export-output-file-name' specifications."
+  ;; Export from a file: name is built from original file name.
+  (should
+   (org-test-with-temp-text-in-file "Test"
+     (equal (concat (file-name-as-directory ".")
+		    (file-name-nondirectory
+		     (file-name-sans-extension (buffer-file-name))))
+	    (file-name-sans-extension (org-export-output-file-name ".ext")))))
+  ;; When exporting to subtree, check EXPORT_FILE_NAME property first.
+  (should
+   (org-test-with-temp-text-in-file
+       "* Test\n  :PROPERTIES:\n  :EXPORT_FILE_NAME: test\n  :END:"
+     (equal (org-export-output-file-name ".ext" t) "./test.ext")))
+  ;; From a buffer not associated to a file, too.
+  (should
+   (org-test-with-temp-text
+       "* Test\n  :PROPERTIES:\n  :EXPORT_FILE_NAME: test\n  :END:"
+     (equal (org-export-output-file-name ".ext" t) "./test.ext")))
+  ;; When provided name is absolute, preserve it.
+  (should
+   (org-test-with-temp-text
+       (format "* Test\n  :PROPERTIES:\n  :EXPORT_FILE_NAME: %s\n  :END:"
+	       (expand-file-name "test"))
+     (file-name-absolute-p (org-export-output-file-name ".ext" t))))
+  ;; When PUB-DIR argument is provided, use it.
+  (should
+   (org-test-with-temp-text-in-file "Test"
+     (equal (file-name-directory
+	     (org-export-output-file-name ".ext" nil "dir/"))
+	    "dir/")))
+  ;; When returned name would overwrite original file, add EXTENSION
+  ;; another time.
+  (should
+   (org-test-at-id "75282ba2-f77a-4309-a970-e87c149fe125"
+     (equal (org-export-output-file-name ".org") "./normal.org.org"))))
+
 (ert-deftest test-org-export/expand-include ()
   "Test file inclusion in an Org buffer."
   ;; Error when file isn't specified.