summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-12-31 12:29:20 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-12-31 12:29:20 +0100
commit4ce104bf44c4a79914247fbf0d2ee2252a5b2556 (patch)
tree6bec42847c25367d7388fe862e3043da360aa53c
parentccf2b988af90878115aabd100bc62a5d6d2eefff (diff)
parentdff9cf9c80748236d2fa3cb5da11c2c94e944b03 (diff)
downloadorg-mode-4ce104bf44c4a79914247fbf0d2ee2252a5b2556.tar.gz
Merge branch 'maint'
-rw-r--r--lisp/ox-publish.el84
1 files changed, 54 insertions, 30 deletions
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index f4943c5..a7a9596 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -461,37 +461,61 @@ This splices all the components into the list."
(org-publish-property :include project))))))
(defun org-publish-get-project-from-filename (filename &optional up)
- "Return the project that FILENAME belongs to."
+ "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 (expand-file-name filename))
- project-name)
-
- (catch 'p-found
- (dolist (prj org-publish-project-alist)
- (unless (plist-get (cdr prj) :components)
- ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
- (let* ((r (plist-get (cdr prj) :recursive))
- (b (expand-file-name (file-name-as-directory
- (plist-get (cdr prj) :base-directory))))
- (x (or (plist-get (cdr prj) :base-extension) "org"))
- (e (plist-get (cdr prj) :exclude))
- (i (plist-get (cdr prj) :include))
- (xm (concat "\\`" b
- (if r ".+" "[^/]+")
- (and (not (eq x 'any))
- (format "\\.\\(%s\\)\\'" x)))))
- (when
- (or (and i
- (member filename
- (dolist (file i) (expand-file-name file b))))
- (and (not (and e (string-match e filename)))
- (string-match xm filename)))
- (setq project-name (car prj))
- (throw 'p-found project-name))))))
- (when up
- (dolist (prj org-publish-project-alist)
- (if (member project-name (plist-get (cdr prj) :components))
- (setq project-name (car prj)))))
- (assoc project-name org-publish-project-alist)))
+ (project
+ (cl-some
+ (lambda (p)
+ ;; Ignore meta-projects.
+ (unless (org-publish-property :components p)
+ (let ((base (expand-file-name
+ (org-publish-property :base-directory p))))
+ (cond
+ ;; Check if FILENAME is explicitly included in one
+ ;; project.
+ ((member filename
+ (mapcar (lambda (f) (expand-file-name f base))
+ (org-publish-property :include p)))
+ p)
+ ;; Exclude file names matching :exclude property.
+ ((let ((exclude-re (org-publish-property :exclude p)))
+ (and exclude-re
+ (string-match-p exclude-re
+ (file-relative-name filename base))))
+ nil)
+ ;; Check :extension. Handle special `any'
+ ;; extension.
+ ((let ((extension (org-publish-property :base-extension p)))
+ (not (or (eq extension 'any)
+ (string= (or extension "org")
+ (file-name-extension filename)))))
+ nil)
+ ;; 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 (string-prefix-p base filename) p))
+ ((equal base (file-name-directory filename)) p)
+ (t nil)))))
+ org-publish-project-alist)))
+ (cond
+ ((not project) nil)
+ ((not up) project)
+ ;; When optional argument UP is non-nil, return the top-most
+ ;; meta-project effectively publishing FILENAME.
+ (t
+ (letrec ((find-parent-project
+ (lambda (project)
+ (or (cl-some
+ (lambda (p)
+ (and (member (car project)
+ (org-publish-property :components p))
+ (funcall find-parent-project p)))
+ org-publish-project-alist)
+ project))))
+ (funcall find-parent-project project))))))