summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-02-13 14:10:28 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-02-13 14:10:28 +0100
commit2a7a4a65adbb1e211363ff43cd82ebd348598de7 (patch)
treef5668952098c551cf0421c96c1695e888313bb15
parentc29efc8f912f00db99edc98c113e68a9ef32b507 (diff)
parent7c21dfc771d2a2f44870c80f34001c835690a77d (diff)
downloadorg-mode-2a7a4a65adbb1e211363ff43cd82ebd348598de7.tar.gz
Merge branch 'maint'
-rw-r--r--lisp/org-compat.el37
-rw-r--r--lisp/ox-publish.el54
-rw-r--r--testing/examples/pub-symlink/link.org2
l---------testing/examples/pub/link1
-rw-r--r--testing/lisp/test-ox-publish.el17
5 files changed, 54 insertions, 57 deletions
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index acd5c3e..af2ef02 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -87,43 +87,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)))))
-
-;; `string-collate-lessp' is new in Emacs 25.
-(defalias 'org-string-collate-lessp
- (if (fboundp 'string-collate-lessp)
- 'string-collate-lessp
- 'string-lessp))
-
;;; Obsolete aliases (remove them after the next major release).
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index 0b24dbc..aa14db0 100644
--- a/lisp/ox-publish.el
+++ b/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
@@ -1009,7 +1027,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
@@ -1118,7 +1136,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
@@ -1163,7 +1181,7 @@ references with `org-export-get-reference'."
file)
"MissingReference"))
(t
- (let* ((filename (file-truename file))
+ (let* ((filename (expand-file-name file))
(crossrefs
(org-publish-cache-get-file-property filename :crossrefs nil t))
(cells
diff --git a/testing/examples/pub-symlink/link.org b/testing/examples/pub-symlink/link.org
new file mode 100644
index 0000000..9fded34
--- /dev/null
+++ b/testing/examples/pub-symlink/link.org
@@ -0,0 +1,2 @@
+# Time-stamp: <2018-02-13 10:12:03 ngz>
+symlink
diff --git a/testing/examples/pub/link b/testing/examples/pub/link
new file mode 120000
index 0000000..663715b
--- /dev/null
+++ b/testing/examples/pub/link
@@ -0,0 +1 @@
+/home/ngz/dev/org-mode/testing/examples/pub-symlink \ No newline at end of file
diff --git a/testing/lisp/test-ox-publish.el b/testing/lisp/test-ox-publish.el
index 5097502..47d83f9 100644
--- a/testing/lisp/test-ox-publish.el
+++ b/testing/lisp/test-ox-publish.el
@@ -415,7 +415,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
@@ -430,6 +431,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))
@@ -464,7 +478,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))