Browse Source

ox-publish: Follow symlink directories

* lisp/org-compat.el (directory-files-recursively): Remove
  compatibility function, no longer needed.
* lisp/ox-publish.el (org-publish--expand-file-name):
(org-publish-org-to):
(org-publish-collect-index):
(org-publish--store-crossrefs):
(org-publish-resolve-external-link): Preserve symlinks in file name.
(org-publish-get-base-files): Follow symlink directories.
(org-publish-get-project-from-filename): Preserve symlinks in file
name.  Do not use `file-in-directory-p', which ignores symlinks.

Reported-by: Michel Damiens <michel.damiens@gmail.com>
<http://lists.gnu.org/r/emacs-orgmode/2018-02/msg00186.html>
Nicolas Goaziou 1 year ago
parent
commit
7c21dfc771

+ 0 - 31
lisp/org-compat.el

@@ -72,37 +72,6 @@
 	  (and (memq system-type '(windows-nt ms-dos))
 	       (= lastc ?\\))))))
 
-(unless (fboundp 'directory-files-recursively)
-  (defun directory-files-recursively (dir regexp &optional include-directories)
-    "Return list of all files under DIR that have file names matching REGEXP.
-This function works recursively.  Files are returned in \"depth first\"
-order, and files from each directory are sorted in alphabetical order.
-Each file name appears in the returned list in its absolute form.
-Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
-output directories whose names match REGEXP."
-    (let ((result nil)
-	  (files nil)
-	  ;; When DIR is "/", remote file names like "/method:" could
-	  ;; also be offered.  We shall suppress them.
-	  (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
-      (dolist (file (sort (file-name-all-completions "" dir)
-			  'string<))
-	(unless (member file '("./" "../"))
-	  (if (directory-name-p file)
-	      (let* ((leaf (substring file 0 (1- (length file))))
-		     (full-file (expand-file-name leaf dir)))
-		;; Don't follow symlinks to other directories.
-		(unless (file-symlink-p full-file)
-		  (setq result
-			(nconc result (directory-files-recursively
-				       full-file regexp include-directories))))
-		(when (and include-directories
-			   (string-match regexp leaf))
-		  (setq result (nconc result (list full-file)))))
-	    (when (string-match regexp file)
-	      (push (expand-file-name file dir) files)))))
-      (nconc result (nreverse files)))))
-
 
 ;;; Obsolete aliases (remove them after the next major release).
 

+ 36 - 18
lisp/ox-publish.el

@@ -405,11 +405,9 @@ definition."
 (defun org-publish--expand-file-name (file project)
   "Return full file name for FILE in PROJECT.
 When FILE is a relative file name, it is expanded according to
-project base directory.  Always return the true name of the file,
-ignoring symlinks."
-  (file-truename
-   (if (file-name-absolute-p file) file
-     (expand-file-name file (org-publish-property :base-directory project)))))
+project base directory."
+  (if (file-name-absolute-p file) file
+    (expand-file-name file (org-publish-property :base-directory project))))
 
 (defun org-publish-expand-projects (projects-alist)
   "Expand projects in PROJECTS-ALIST.
@@ -436,10 +434,32 @@ This splices all the components into the list."
 	 (match (if (eq extension 'any) ""
 		  (format "^[^\\.].*\\.\\(%s\\)$" extension)))
 	 (base-files
-	  (cl-remove-if #'file-directory-p
-			(if (org-publish-property :recursive project)
-			    (directory-files-recursively base-dir match)
-			  (directory-files base-dir t match t)))))
+	  (cond ((not (file-exists-p base-dir)) nil)
+		((not (org-publish-property :recursive project))
+		 (cl-remove-if #'file-directory-p
+			       (directory-files base-dir t match t)))
+		(t
+		 ;; Find all files recursively.  Unlike to
+		 ;; `directory-files-recursively', we follow symlinks
+		 ;; to other directories.
+		 (letrec ((files nil)
+			  (walk-tree
+			   (lambda (dir depth)
+			     (when (> depth 100)
+			       (error "Apparent cycle of symbolic links for %S"
+				      base-dir))
+			     (dolist (f (file-name-all-completions "" dir))
+			       (pcase f
+				 ((or "./" "../") nil)
+				 ((pred directory-name-p)
+				  (funcall walk-tree
+					   (expand-file-name f dir)
+					   (1+ depth)))
+				 ((pred (string-match match))
+				  (push (expand-file-name f dir) files))
+				 (_ nil)))
+			     files)))
+		   (funcall walk-tree base-dir 0))))))
     (org-uniquify
      (append
       ;; Files from BASE-DIR.  Apply exclusion filter before adding
@@ -468,13 +488,13 @@ This splices all the components into the list."
   "Return a project that FILENAME belongs to.
 When UP is non-nil, return a meta-project (i.e., with a :components part)
 publishing FILENAME."
-  (let* ((filename (file-truename filename))
+  (let* ((filename (expand-file-name filename))
 	 (project
 	  (cl-some
 	   (lambda (p)
 	     ;; Ignore meta-projects.
 	     (unless (org-publish-property :components p)
-	       (let ((base (file-truename
+	       (let ((base (expand-file-name
 			    (org-publish-property :base-directory p))))
 		 (cond
 		  ;; Check if FILENAME is explicitly included in one
@@ -499,9 +519,7 @@ publishing FILENAME."
 		  ;; Check if FILENAME belong to project's base
 		  ;; directory, or some of its sub-directories
 		  ;; if :recursive in non-nil.
-		  ((org-publish-property :recursive p)
-		   (and (file-in-directory-p filename base) p))
-		  ((file-equal-p base (file-name-directory filename)) p)
+		  ((member filename (org-publish-get-base-files p)) p)
 		  (t nil)))))
 	   org-publish-project-alist)))
     (cond
@@ -557,7 +575,7 @@ Return output file name."
 	       `(:crossrefs
 		 ,(org-publish-cache-get-file-property
 		   ;; Normalize file names in cache.
-		   (file-truename filename) :crossrefs nil t)
+		   (expand-file-name filename) :crossrefs nil t)
 		 :filter-final-output
 		 (org-publish--store-crossrefs
 		  org-publish-collect-index
@@ -1007,7 +1025,7 @@ PARENT is a reference to the headline, if any, containing the
 original index keyword.  When non-nil, this reference is a cons
 cell.  Its CAR is a symbol among `id', `custom-id' and `name' and
 its CDR is a string."
-  (let ((file (file-truename (plist-get info :input-file))))
+  (let ((file (expand-file-name (plist-get info :input-file))))
     (org-publish-cache-set-file-property
      file :index
      (delete-dups
@@ -1116,7 +1134,7 @@ a plist.
 This function is meant to be used as a final output filter.  See
 `org-publish-org-to'."
   (org-publish-cache-set-file-property
-   (file-truename (plist-get info :input-file))
+   (expand-file-name (plist-get info :input-file))
    :crossrefs
    ;; Update `:crossrefs' so as to remove unused references and search
    ;; cells.  Actually used references are extracted from
@@ -1147,7 +1165,7 @@ references with `org-export-get-reference'."
 		 search
 		 file)
 	"MissingReference")
-    (let* ((filename (file-truename file))
+    (let* ((filename (expand-file-name file))
 	   (crossrefs
 	    (org-publish-cache-get-file-property filename :crossrefs nil t))
 	   (cells

+ 2 - 0
testing/examples/pub-symlink/link.org

@@ -0,0 +1,2 @@
+# Time-stamp: <2018-02-13 10:12:03 ngz>
+symlink

+ 1 - 0
testing/examples/pub/link

@@ -0,0 +1 @@
+/home/ngz/dev/org-mode/testing/examples/pub-symlink

+ 15 - 2
testing/lisp/test-ox-publish.el

@@ -352,7 +352,8 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
 		 (file (expand-file-name "a.org" base))
 		 (org-publish-project-alist
 		  `(("p1" :base-directory "/other/")
-		    ("p2" :base-directory ,base))))
+		    ("p2" :base-directory ,base)
+		    ("p3" :base-directory ,base))))
 	    (car (org-publish-get-project-from-filename file)))))
   ;; When :recursive in non-nil, allow files in sub-directories.
   (should
@@ -367,6 +368,19 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
 	  (org-publish-project-alist
 	   `(("p" :base-directory ,base :recursive nil))))
      (org-publish-get-project-from-filename file)))
+  ;; Also, when :recursive is non-nil, follow symlinks to directories.
+  (should
+   (let* ((base (expand-file-name "examples/pub/" org-test-dir))
+	  (file (expand-file-name "link/link.org" base))
+	  (org-publish-project-alist
+	   `(("p" :base-directory ,base :recursive t))))
+     (org-publish-get-project-from-filename file)))
+  (should-not
+   (let* ((base (expand-file-name "examples/pub/" org-test-dir))
+	  (file (expand-file-name "link/link.org" base))
+	  (org-publish-project-alist
+	   `(("p" :base-directory ,base :recursive nil))))
+     (org-publish-get-project-from-filename file)))
   ;; Check :base-extension.
   (should
    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
@@ -401,7 +415,6 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
 	  (org-publish-project-alist
 	   `(("p" :base-directory ,base :recursive t :base-extension any))))
      (org-publish-get-base-files (org-publish-get-project-from-filename file))))
-
   ;; Check :exclude property.
   (should-not
    (let* ((base (expand-file-name "examples/pub/" org-test-dir))