mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-26 07:33:39 +00:00
Code

Merge branch 'maint'

Browse Source
This commit is contained in:
Nicolas Goaziou 2018-02-13 14:10:28 +01:00
commit 2a7a4a65ad
5 changed files with 54 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
lisp/org-compat.el
View File

@ -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).

54
lisp/ox-publish.el
View File

@ -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

2
testing/examples/pub-symlink/link.org Normal file
View File

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

1
testing/examples/pub/link Symbolic link
View File

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

17
testing/lisp/test-ox-publish.el
View File

@ -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))