diff options
Diffstat (limited to 'lisp/org/ox-publish.el')
| -rw-r--r-- | lisp/org/ox-publish.el | 707 |
1 files changed, 391 insertions, 316 deletions
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 4ebc073990e..884d6bf6910 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -1,4 +1,4 @@ -;;; ox-publish.el --- Publish Related Org Mode Files as a Website +;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2017 Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> @@ -38,7 +38,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'ox) @@ -54,16 +54,23 @@ "This will cache timestamps and titles for files in publishing projects. Blocks could hash sha1 values here.") +(defvar org-publish-after-publishing-hook nil + "Hook run each time a file is published. +Every function in this hook will be called with two arguments: +the name of the original file and the name of the file +produced.") + (defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." + "Options for publishing a set of files." :tag "Org Publishing" :group 'org) (defcustom org-publish-project-alist nil "Association list to control publishing behavior. -Each element of the alist is a publishing “project”. The CAR of +\\<org-mode-map> +Each element of the alist is a publishing project. The car of each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: +cdr of each element is in one of the following forms: 1. A well-formed property list with an even number of elements, alternating keys and values, specifying parameters for the @@ -80,7 +87,7 @@ When the CDR of an element of org-publish-project-alist is in this second form, the elements of the list after `:components' are taken to be components of the project, which group together files requiring different publishing options. When you publish -such a project with \\[org-publish], the components all publish. +such a project with `\\[org-publish]', the components all publish. When a property is given a value in `org-publish-project-alist', its setting overrides the value of the corresponding user @@ -97,13 +104,17 @@ Most properties are optional, but some should always be set: Extension (without the dot!) of source files. This can be a regular expression. If not given, \"org\" will be used as - default extension. + default extension. If it is `any', include all the files, + even without extension. `:publishing-directory' Directory (possibly remote) where output files will be published. +If `:recursive' is non-nil files in sub-directories of +`:base-directory' are considered. + The `:exclude' property may be used to prevent certain files from being published. Its value may be a string or regexp matching file names you don't want to be published. @@ -135,12 +146,16 @@ date. `:preparation-function' Function to be called before publishing this project. This - may also be a list of functions. + may also be a list of functions. Preparation functions are + called with the project properties list as their sole + argument. `:completion-function' Function to be called after publishing this project. This - may also be a list of functions. + may also be a list of functions. Completion functions are + called with the project properties list as their sole + argument. Some properties control details of the Org publishing process, and are equivalent to the corresponding user variables listed in @@ -169,7 +184,9 @@ included. See the back-end documentation for more information. :with-footnotes `org-export-with-footnotes' :with-inlinetasks `org-export-with-inlinetasks' :with-latex `org-export-with-latex' + :with-planning `org-export-with-planning' :with-priority `org-export-with-priority' + :with-properties `org-export-with-properties' :with-smart-quotes `org-export-with-smart-quotes' :with-special-strings `org-export-with-special-strings' :with-statistics-cookies' `org-export-with-statistics-cookies' @@ -179,7 +196,7 @@ included. See the back-end documentation for more information. :with-tags `org-export-with-tags' :with-tasks `org-export-with-tasks' :with-timestamps `org-export-with-timestamps' - :with-planning `org-export-with-planning' + :with-title `org-export-with-title' :with-todo-keywords `org-export-with-todo-keywords' The following properties may be used to control publishing of @@ -333,7 +350,7 @@ You could use brackets to delimit on what part the link will be. (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) (defun org-publish-needed-p - (filename &optional pub-dir pub-func true-pub-dir base-dir) + (filename &optional pub-dir pub-func _true-pub-dir base-dir) "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if @@ -346,11 +363,11 @@ still decide about that independently." filename pub-dir pub-func base-dir)))) (if rtn (message "Publishing file %s using `%s'" filename pub-func) (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) + (message "Skipping unmodified file %s" filename))) rtn)) (defun org-publish-update-timestamp - (filename &optional pub-dir pub-func base-dir) + (filename &optional pub-dir pub-func _base-dir) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) @@ -359,10 +376,9 @@ If there is no timestamp, create one." (defun org-publish-remove-all-timestamps () "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) + (let ((dir org-publish-timestamp-directory)) (when (and (file-exists-p dir) (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (mapc #'delete-file (directory-files dir 'full "[^.]\\'")) (org-publish-reset-cache)))) @@ -370,6 +386,15 @@ If there is no timestamp, create one." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of `org-publish-project-alist' +(defun org-publish-property (property project &optional default) + "Return value PROPERTY, as a symbol, in PROJECT. +DEFAULT is returned when PROPERTY is not actually set in PROJECT +definition." + (let ((properties (cdr project))) + (if (plist-member properties property) + (plist-get properties property) + default))) + (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -395,12 +420,12 @@ This splices all the components into the list." (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) ;; First we sort files: (when org-publish-sitemap-sort-files - (case org-publish-sitemap-sort-files - (alphabetically + (pcase org-publish-sitemap-sort-files + (`alphabetically (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) + (aorg (and (string-suffix-p ".org" a) (not adir))) (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) + (borg (and (string-suffix-p ".org" b) (not bdir))) (A (if aorg (concat (file-name-directory a) (org-publish-find-title a)) a)) (B (if borg (concat (file-name-directory b) @@ -408,57 +433,56 @@ This splices all the components into the list." (setq retval (if org-publish-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((anti-chronologically chronologically) + ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a)) (bdate (org-publish-find-date b)) (A (+ (lsh (car adate) 16) (cadr adate))) (B (+ (lsh (car bdate) 16) (cadr bdate)))) (setq retval - (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) + (if (eq org-publish-sitemap-sort-files 'chronologically) + (<= A B) (>= A B))))))) ;; Directory-wise wins: (when org-publish-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-publish-sitemap-sort-folders 'first))) + (setq retval (eq org-publish-sitemap-sort-folders 'first))) ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) + (setq retval (eq org-publish-sitemap-sort-folders 'last)))))) retval)) (defun org-publish-get-base-files-1 - (base-dir &optional recurse match skip-file skip-dir) + (base-dir &optional recurse match skip-file skip-dir) "Set `org-publish-temp-files' with files from BASE-DIR directory. If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is non-nil, restrict this list to the files matching the regexp MATCH. If SKIP-FILE is non-nil, skip file matching the regexp SKIP-FILE. If SKIP-DIR is non-nil, don't check directories matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 - f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (let ((all-files (if (not recurse) (directory-files base-dir t match) - ;; If RECURSE is non-nil, we want all files - ;; matching MATCH and sub-directories. - (org-remove-if-not - (lambda (file) - (or (file-directory-p file) - (and match (string-match match file)))) - (directory-files base-dir t))))) - (if (not org-publish-sitemap-requested) all-files - (sort all-files 'org-publish-compare-directory-files))))) + (let ((all-files (if (not recurse) (directory-files base-dir t match) + ;; If RECURSE is non-nil, we want all files + ;; matching MATCH and sub-directories. + (cl-remove-if-not + (lambda (file) + (or (file-directory-p file) + (and match (string-match match file)))) + (directory-files base-dir t))))) + (dolist (f (if (not org-publish-sitemap-requested) all-files + (sort all-files #'org-publish-compare-directory-files))) + (let ((fd-p (file-directory-p f)) + (fnd (file-name-nondirectory f))) + (if (and fd-p recurse + (not (string-match "^\\.+$" fnd)) + (if skip-dir (not (string-match skip-dir fnd)) t)) + (org-publish-get-base-files-1 + f recurse match skip-file skip-dir) + (unless (or fd-p ; This is a directory. + (and skip-file (string-match skip-file fnd)) + (not (file-exists-p (file-truename f))) + (not (string-match match fnd))) + (cl-pushnew f org-publish-temp-files))))))) (defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. @@ -500,51 +524,73 @@ matching filenames." (setq org-publish-sitemap-sort-folders nil)) (setq org-publish-temp-files nil) - (if org-publish-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) + (when org-publish-sitemap-requested + (cl-pushnew (expand-file-name (concat base-dir sitemap-filename)) org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) + (dolist (f include-list org-publish-temp-files) + (cl-pushnew (expand-file-name (concat base-dir f)) + org-publish-temp-files)))) (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 ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or (and i - (member filename - (mapcar (lambda (file) - (expand-file-name file b)) - i))) - (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 (file-truename + (org-publish-property :base-directory p)))) + (cond + ;; Check if FILENAME is explicitly included in one + ;; project. + ((cl-some (lambda (f) (file-equal-p f 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 (file-in-directory-p filename base) p)) + ((file-equal-p 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)))))) @@ -567,29 +613,31 @@ Return output file name." (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) ;; Check if a buffer visiting FILENAME is already open. (let* ((org-inhibit-startup t) - (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file-noselect filename)))) - (prog1 (with-current-buffer work-buffer - (let ((output-file - (org-export-output-file-name extension nil pub-dir)) - (body-p (plist-get plist :body-only))) - (org-export-to-file backend output-file - nil nil nil body-p - ;; Add `org-publish-collect-numbering' and - ;; `org-publish-collect-index' to final output - ;; filters. The latter isn't dependent on - ;; `:makeindex', since we want to keep it up-to-date - ;; in cache anyway. - (org-combine-plists - plist - `(:filter-final-output - ,(cons 'org-publish-collect-numbering - (cons 'org-publish-collect-index - (plist-get plist :filter-final-output)))))))) + (visiting (find-buffer-visiting filename)) + (work-buffer (or visiting (find-file-noselect filename)))) + (unwind-protect + (with-current-buffer work-buffer + (let ((output (org-export-output-file-name extension nil pub-dir))) + (org-export-to-file backend output + nil nil nil (plist-get plist :body-only) + ;; Add `org-publish--store-crossrefs' and + ;; `org-publish-collect-index' to final output filters. + ;; The latter isn't dependent on `:makeindex', since we + ;; want to keep it up-to-date in cache anyway. + (org-combine-plists + plist + `(:crossrefs + ,(org-publish-cache-get-file-property + ;; Normalize file names in cache. + (file-truename filename) :crossrefs nil t) + :filter-final-output + (org-publish--store-crossrefs + org-publish-collect-index + ,@(plist-get plist :filter-final-output))))))) ;; Remove opened buffer in the process. - (unless visitingp (kill-buffer work-buffer))))) + (unless visiting (kill-buffer work-buffer))))) -(defun org-publish-attachment (plist filename pub-dir) +(defun org-publish-attachment (_plist filename pub-dir) "Publish a file with no transformation of any kind. FILENAME is the filename of the Org file to be published. PLIST @@ -599,11 +647,12 @@ publishing directory. Return output file name." (unless (file-directory-p pub-dir) (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename - (expand-file-name (file-name-nondirectory filename) pub-dir) - t))) + (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir))) + (unless (file-equal-p (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) + (copy-file filename output t)) + ;; Return file name. + output)) @@ -612,108 +661,96 @@ Return output file name." (defun org-publish-file (filename &optional project no-cache) "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." +If NO-CACHE is not nil, do not initialize `org-publish-cache'. +This is needed, since this function is used to publish single +files, when entire projects are published (see +`org-publish-projects')." (let* ((project (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) + (org-publish-get-project-from-filename filename) + (user-error "File %S is not part of any known project" + (abbreviate-file-name filename)))) (project-plist (cdr project)) - (ftname (expand-file-name filename)) (publishing-function - (or (plist-get project-plist :publishing-function) - (error "No publishing function chosen"))) + (pcase (plist-get project-plist :publishing-function) + (`nil (user-error "No publishing function chosen")) + ((and f (pred listp)) f) + (f (list f)))) (base-dir (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir + (or (org-publish-property :base-directory project) + (user-error "Project %S does not have :base-directory defined" + (car project))))) + (pub-base-dir (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) + (or (org-publish-property :publishing-directory project) + (user-error + "Project %S does not have :publishing-directory defined" + (car project))))) + (pub-dir + (file-name-directory + (expand-file-name (file-relative-name filename base-dir) + pub-base-dir)))) (unless no-cache (org-publish-initialize-cache (car project))) - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (when (org-publish-needed-p - filename pub-dir f tmp-pub-dir base-dir) - (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f base-dir))) - publishing-function) - (when (org-publish-needed-p - filename pub-dir publishing-function tmp-pub-dir base-dir) - (funcall publishing-function project-plist filename tmp-pub-dir) - (org-publish-update-timestamp - filename pub-dir publishing-function base-dir))) - (unless no-cache (org-publish-write-cache-file)))) - -(defun org-publish--run-functions (functions) - (cond - ((null functions) nil) - ((functionp functions) (funcall functions)) - ((consp functions) (mapc #'funcall functions)) - (t (error "Neither a function nor a list: %S" functions)))) + ;; Allow chain of publishing functions. + (dolist (f publishing-function) + (when (org-publish-needed-p filename pub-base-dir f pub-dir base-dir) + (let ((output (funcall f project-plist filename pub-dir))) + (org-publish-update-timestamp filename pub-base-dir f base-dir) + (run-hook-with-args 'org-publish-after-publishing-hook + filename + output)))) + ;; Make sure to write cache to file after successfully publishing + ;; a file, so as to minimize impact of a publishing failure. + (org-publish-write-cache-file))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. If `:auto-sitemap' is set, publish the sitemap too. If -`:makeindex' is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-publish-sitemap-date-format - (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-publish-sitemap-file-entry-format - (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function - (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) - (theindex +`:makeindex' is set, also produce a file \"theindex.org\"." + (dolist (project (org-publish-expand-projects projects)) + (let ((project-plist (cdr project))) + (let ((fun (plist-get project-plist :preparation-function))) + (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) + ((functionp fun) (funcall fun project-plist)))) + ;; Each project uses its own cache file. + (org-publish-initialize-cache (car project)) + (when (plist-get project-plist :auto-sitemap) + (let ((sitemap-filename + (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (sitemap-function + (or (plist-get project-plist :sitemap-function) + #'org-publish-org-sitemap)) + (org-publish-sitemap-date-format + (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (org-publish-sitemap-file-entry-format + (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format))) + (funcall sitemap-function project sitemap-filename))) + ;; Publish all files from PROJECT except "theindex.org". Its + ;; publishing will be deferred until "theindex.inc" is + ;; populated. + (let ((theindex (expand-file-name "theindex.org" - (plist-get project-plist :base-directory)))) - (org-publish--run-functions preparation-function) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - ;; Publish all files from PROJECT excepted "theindex.org". Its - ;; publishing will be deferred until "theindex.inc" is - ;; populated. - (dolist (file files) - (unless (equal file theindex) - (org-publish-file file project t))) - ;; Populate "theindex.inc", if needed, and publish - ;; "theindex.org". - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - project (plist-get project-plist :base-directory)) - (org-publish-file theindex project t)) - (org-publish--run-functions completion-function) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) + (plist-get project-plist :base-directory))) + (exclude-regexp (plist-get project-plist :exclude))) + (dolist (file (org-publish-get-base-files project exclude-regexp)) + (unless (file-equal-p file theindex) + (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". + (when (plist-get project-plist :makeindex) + (org-publish-index-generate-theindex + project (plist-get project-plist :base-directory)) + (org-publish-file theindex project t))) + (let ((fun (plist-get project-plist :completion-function))) + (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) + ((functionp fun) (funcall fun project-plist)))) + (org-publish-write-cache-file)))) (defun org-publish-org-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. @@ -723,19 +760,18 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (dir (file-name-as-directory (plist-get project-plist :base-directory))) (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) + (indent-str (make-string 2 ?\s)) (exclude-regexp (plist-get project-plist :exclude)) (files (nreverse (org-publish-get-base-files project exclude-regexp))) (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) + (concat "Sitemap for project " (car project)))) (sitemap-style (or (plist-get project-plist :sitemap-style) 'tree)) (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) file sitemap-buffer) (with-current-buffer (let ((org-inhibit-startup t)) @@ -744,14 +780,12 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (erase-buffer) (insert (concat "#+TITLE: " sitemap-title "\n\n")) (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) + (let ((link (file-relative-name file dir)) (oldlocal localdir)) (when sitemap-sans-extension (setq link (file-name-sans-extension link))) ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) + (unless (file-equal-p sitemap-filename file) (if (eq sitemap-style 'list) (message "Generating list-style sitemap for %s" sitemap-title) (message "Generating tree-style sitemap for %s" sitemap-title) @@ -840,17 +874,15 @@ time in `current-time' format." (date (plist-get (with-current-buffer file-buf (if visiting - (org-export-with-buffer-copy (org-export-get-environment)) + (org-export-with-buffer-copy + (org-export-get-environment)) (org-export-get-environment))) :date))) (unless visiting (kill-buffer file-buf)) - ;; DATE is either a timestamp object or a secondary string. If it - ;; is a timestamp or if the secondary string contains a timestamp, + ;; DATE is a secondary string. If it contains a timestamp, ;; convert it to internal format. Otherwise, use FILE ;; modification time. - (cond ((eq (org-element-type date) 'timestamp) - (org-time-string-to-time (org-element-interpret-data date))) - ((let ((ts (and (consp date) (assq 'timestamp date)))) + (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) (and ts (let ((value (org-element-interpret-data ts))) (and (org-string-nw-p value) @@ -877,25 +909,28 @@ When optional argument FORCE is non-nil, force publishing all files in PROJECT. With a non-nil optional argument ASYNC, publishing will be done asynchronously, in another process." (interactive - (list - (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - current-prefix-arg)) - (let ((project-alist (if (not (stringp project)) (list project) - ;; If this function is called in batch mode, - ;; project is still a string here. - (list (assoc project org-publish-project-alist))))) - (if async - (org-export-async-start (lambda (results) nil) - `(let ((org-publish-use-timestamps-flag - (if ',force nil ,org-publish-use-timestamps-flag))) - (org-publish-projects ',project-alist))) - (save-window-excursion - (let* ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects project-alist)))))) + (list (assoc (completing-read "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + current-prefix-arg)) + (let ((project (if (not (stringp project)) project + ;; If this function is called in batch mode, + ;; PROJECT is still a string here. + (assoc project org-publish-project-alist)))) + (cond + ((not project)) + (async + (org-export-async-start (lambda (_) nil) + `(let ((org-publish-use-timestamps-flag + ,(and (not force) org-publish-use-timestamps-flag))) + ;; Expand components right now as external process may not + ;; be aware of complete `org-publish-project-alist'. + (org-publish-projects + ',(org-publish-expand-projects (list project)))))) + (t (save-window-excursion + (let ((org-publish-use-timestamps-flag + (and (not force) org-publish-use-timestamps-flag))) + (org-publish-projects (list project)))))))) ;;;###autoload (defun org-publish-all (&optional force async) @@ -906,7 +941,7 @@ optional argument ASYNC, publishing will be done asynchronously, in another process." (interactive "P") (if async - (org-export-async-start (lambda (results) nil) + (org-export-async-start (lambda (_) nil) `(progn (when ',force (org-publish-remove-all-timestamps)) (let ((org-publish-use-timestamps-flag @@ -928,7 +963,7 @@ asynchronously, in another process." (interactive "P") (let ((file (buffer-file-name (buffer-base-buffer)))) (if async - (org-export-async-start (lambda (results) nil) + (org-export-async-start (lambda (_) nil) `(let ((org-publish-use-timestamps-flag (if ',force nil ,org-publish-use-timestamps-flag))) (org-publish-file ,file))) @@ -954,7 +989,7 @@ the project." ;;; Index generation -(defun org-publish-collect-index (output backend info) +(defun org-publish-collect-index (output _backend info) "Update index for a file in cache. OUTPUT is the output from transcoding current file. BACKEND is @@ -969,7 +1004,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 (plist-get info :input-file))) + (let ((file (file-truename (plist-get info :input-file)))) (org-publish-cache-set-file-property file :index (delete-dups @@ -1027,10 +1062,11 @@ publishing directory." ;; Compute the first difference between last entry and ;; current one: it tells the level at which new items ;; should be added. - (let* ((rank (if (equal entry last-entry) (1- (length entry)) - (loop for n from 0 to (length entry) - unless (equal (nth n entry) (nth n last-entry)) - return n))) + (let* ((rank + (if (equal entry last-entry) (1- (length entry)) + (cl-loop for n from 0 to (length entry) + unless (equal (nth n entry) (nth n last-entry)) + return n))) (len (length (nthcdr rank entry)))) ;; For each term after the first difference, create ;; a new sub-list with the term as body. Moreover, @@ -1038,18 +1074,18 @@ publishing directory." (dotimes (n len) (insert (concat - (make-string (* (+ rank n) 2) ? ) " - " + (make-string (* (+ rank n) 2) ?\s) " - " (if (not (= (1- len) n)) (nth (+ rank n) entry) ;; Last term: Link it to TARGET, if possible. (let ((target (nth 2 idx))) (format "[[%s][%s]]" ;; Destination. - (case (car target) - ('nil (format "file:%s" file)) - (id (format "id:%s" (cdr target))) - (custom-id (format "file:%s::#%s" file (cdr target))) - (otherwise (format "file:%s::*%s" file (cdr target)))) + (pcase (car target) + (`nil (format "file:%s" file)) + (`id (format "id:%s" (cdr target))) + (`custom-id (format "file:%s::#%s" file (cdr target))) + (_ (format "file:%s::*%s" file (cdr target)))) ;; Description. (car (last entry))))) "\n")))) @@ -1068,31 +1104,64 @@ publishing directory." ;; This part implements tools to resolve [[file.org::*Some headline]] ;; links, where "file.org" belongs to the current project. -(defun org-publish-collect-numbering (output backend info) +(defun org-publish--store-crossrefs (output _backend info) + "Store cross-references for current published file. + +OUPUT is the produced output, as a string. BACKEND is the export +back-end used, as a symbol. INFO is the final export state, as +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 - (plist-get info :input-file) :numbering - (mapcar (lambda (entry) - (cons (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value (car entry)))) - (cdr entry))) - (plist-get info :headline-numbering))) + (file-truename (plist-get info :input-file)) + :crossrefs + ;; Update `:crossrefs' so as to remove unused references and search + ;; cells. Actually used references are extracted from + ;; `:internal-references', with references as strings removed. See + ;; `org-export-get-reference' for details. + (cl-remove-if (lambda (pair) (stringp (car pair))) + (plist-get info :internal-references))) ;; Return output unchanged. output) -(defun org-publish-resolve-external-fuzzy-link (file fuzzy) - "Return numbering for headline matching FUZZY search in FILE. - -Return value is a list of numbers, or nil. This function allows -the resolution of external fuzzy links like: - - [[file.org::*fuzzy][description]]" - (when org-publish-cache - (cdr (assoc (org-split-string - (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy)) - (org-publish-cache-get-file-property - (expand-file-name file) :numbering nil t))))) +(defun org-publish-resolve-external-link (search file) + "Return reference for element matching string SEARCH in FILE. + +Return value is an internal reference, as a string. + +This function allows resolving external links with a search +option, e.g., + + [[file.org::*heading][description]] + [[file.org::#custom-id][description]] + [[file.org::fuzzy][description]] + +It only makes sense to use this if export back-end builds +references with `org-export-get-reference'." + (if (not org-publish-cache) + (progn + (message "Reference %S in file %S cannot be resolved without publishing" + search + file) + "MissingReference") + (let* ((filename (file-truename file)) + (crossrefs + (org-publish-cache-get-file-property filename :crossrefs nil t)) + (cells (org-export-string-to-search-cell search))) + (or + ;; Look for reference associated to search cells triggered by + ;; LINK. It can match when targeted file has been published + ;; already. + (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells)))) + (and known (org-export-format-reference known))) + ;; Search cell is unknown so far. Generate a new internal + ;; reference that will be used when the targeted file will be + ;; published. + (let ((new (org-export-new-reference crossrefs))) + (dolist (cell cells) (push (cons cell new) crossrefs)) + (org-publish-cache-set-file-property filename :crossrefs crossrefs) + (org-export-format-reference new)))))) @@ -1109,13 +1178,12 @@ If FREE-CACHE, empty the cache." (error "Cannot find cache-file name in `org-publish-write-cache-file'")) (with-temp-file cache-file (let (print-level print-length) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (insert "(setq org-publish-cache \ +\(make-hash-table :test 'equal :weakness nil :size 100))\n") (maphash (lambda (k v) (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) + (format "(puthash %S %s%S org-publish-cache)\n" + k (if (or (listp v) (symbolp v)) "'" "") v))) org-publish-cache))) (when free-cache (org-publish-reset-cache)))) @@ -1123,7 +1191,8 @@ If FREE-CACHE, empty the cache." "Initialize the projects cache if not initialized yet and return it." (unless project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) + (error "Cannot initialize `org-publish-cache' without projects name in \ +`org-publish-initialize-cache'")) (unless (file-exists-p org-publish-timestamp-directory) (make-directory org-publish-timestamp-directory t)) @@ -1157,7 +1226,7 @@ If FREE-CACHE, empty the cache." (setq org-publish-cache nil)) (defun org-publish-cache-file-needs-publishing - (filename &optional pub-dir pub-func base-dir) + (filename &optional pub-dir pub-func _base-dir) "Check the timestamp of the last publishing of FILENAME. Return non-nil if the file needs publishing. Also check if any included files have been more recently published, so that @@ -1165,33 +1234,42 @@ the file including them will be republished as well." (unless org-publish-cache (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) - (let* ((case-fold-search t) - (key (org-publish-timestamp-filename filename pub-dir pub-func)) + (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) (pstamp (org-publish-cache-get key)) (org-inhibit-startup t) - (visiting (find-buffer-visiting filename)) - included-files-ctime buf) - + included-files-ctime) (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward - "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1))) - (ctime (org-publish-cache-ctime-of-src included-file))) - (unless (member ctime included-files-ctime) - ;; FIXME: The original code insisted on appending this ctime - ;; to the end of the list, even tho the order seems irrelevant. - (setq included-files-ctime - (append included-files-ctime (list ctime))))))) - (unless visiting (kill-buffer buf))) - (if (null pstamp) t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) - included-files-ctime)))))))))) + (let ((visiting (find-buffer-visiting filename)) + (buf (find-file-noselect filename)) + (case-fold-search t)) + (unwind-protect + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) + (let* ((element (org-element-at-point)) + (included-file + (and (eq (org-element-type element) 'keyword) + (let ((value (org-element-property :value element))) + (and value + (string-match + "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" + value) + (let ((m (match-string 1 value))) + (org-unbracket-string + "\"" "\"" + ;; Ignore search suffix. + (if (string-match "::.*?\"?\\'" m) + (substring m 0 (match-beginning 0)) + m)))))))) + (when included-file + (push (org-publish-cache-ctime-of-src + (expand-file-name included-file)) + included-files-ctime))))) + (unless visiting (kill-buffer buf))))) + (or (null pstamp) + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (or (< pstamp ctime) + (cl-some (lambda (ct) (< ctime ct)) included-files-ctime)))))) (defun org-publish-cache-set-file-property (filename property value &optional project-name) @@ -1206,35 +1284,32 @@ will be created. Return VALUE." filename property value nil project-name)))) (defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) + (filename property &optional default no-create project-name) "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY -or DEFAULT, if the value does not yet exist. If the entry will -be created, unless NO-CREATE is not nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) retval) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) +Use cache file of PROJECT-NAME. Return the value of that PROPERTY, +or DEFAULT, if the value does not yet exist. Create the entry, +if necessary, unless NO-CREATE is non-nil." + (when project-name (org-publish-initialize-cache project-name)) + (let ((properties (org-publish-cache-get filename))) + (cond ((null properties) + (unless no-create + (org-publish-cache-set filename (list property default))) + default) + ((plist-member properties property) (plist-get properties property)) + (t default)))) (defun org-publish-cache-get (key) "Return the value stored in `org-publish-cache' for key KEY. -Returns nil, if no value or nil is found, or the cache does not -exist." +Return nil, if no value or nil is found. Raise an error if the +cache does not exist." (unless org-publish-cache (error "`org-publish-cache-get' called, but no cache present")) (gethash key org-publish-cache)) (defun org-publish-cache-set (key value) "Store KEY VALUE pair in `org-publish-cache'. -Returns value on success, else nil." +Returns value on success, else nil. Raise an error if the cache +does not exist." (unless org-publish-cache (error "`org-publish-cache-set' called, but no cache present")) (puthash key value org-publish-cache)) |