diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2018-02-13 14:10:28 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2018-02-13 14:10:28 +0100 |
commit | 2a7a4a65adbb1e211363ff43cd82ebd348598de7 (patch) | |
tree | f5668952098c551cf0421c96c1695e888313bb15 | |
parent | c29efc8f912f00db99edc98c113e68a9ef32b507 (diff) | |
parent | 7c21dfc771d2a2f44870c80f34001c835690a77d (diff) | |
download | org-mode-2a7a4a65adbb1e211363ff43cd82ebd348598de7.tar.gz |
Merge branch 'maint'
-rw-r--r-- | lisp/org-compat.el | 37 | ||||
-rw-r--r-- | lisp/ox-publish.el | 54 | ||||
-rw-r--r-- | testing/examples/pub-symlink/link.org | 2 | ||||
l--------- | testing/examples/pub/link | 1 | ||||
-rw-r--r-- | testing/lisp/test-ox-publish.el | 17 |
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)) |