diff options
Diffstat (limited to 'lisp/org/ox-publish.el')
| -rw-r--r-- | lisp/org/ox-publish.el | 1247 |
1 files changed, 668 insertions, 579 deletions
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 4ebc073990e..c2416dba381 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> @@ -18,7 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -38,7 +38,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'ox) @@ -46,24 +46,28 @@ ;;; Variables -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - ;; Here, so you find the variable right before it's used the first time: (defvar org-publish-cache nil "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 +84,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 +101,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 +143,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 +181,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 +193,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 @@ -192,18 +206,12 @@ a site-map of files or summary page for a given project. `:sitemap-filename' - Filename for output of sitemap. Defaults to \"sitemap.org\". + Filename for output of site-map. Defaults to \"sitemap.org\". `:sitemap-title' Title of site-map page. Defaults to name of file. - `:sitemap-function' - - Plugin function to use for generation of site-map. Defaults - to `org-publish-org-sitemap', which generates a plain list of - links to all files in the project. - `:sitemap-style' Can be `list' (site-map is just an itemized list of the @@ -211,19 +219,42 @@ a site-map of files or summary page for a given project. structure of the source files is reflected in the site-map). Defaults to `tree'. - `:sitemap-sans-extension' + `:sitemap-format-entry' + + Plugin function used to format entries in the site-map. It + is called with three arguments: the file or directory name + relative to base directory, the site map style and the + current project. It has to return a string. - Remove extension from site-map's file-names. Useful to have - cool URIs (see http://www.w3.org/Provider/Style/URI). - Defaults to nil. + Defaults to `org-publish-sitemap-default-entry', which turns + file names into links and use document titles as + descriptions. For specific formatting needs, one can use + `org-publish-find-date', `org-publish-find-title' and + `org-publish-find-property', to retrieve additional + information about published documents. + + `:sitemap-function' + + Plugin function to use for generation of site-map. It is + called with two arguments: the title of the site-map, as + a string, and a representation of the files involved in the + project, as returned by `org-list-to-lisp'. The latter can + further be transformed using `org-list-to-generic', + `org-list-to-subtree' and alike. It has to return a string. + + Defaults to `org-publish-sitemap-default', which generates + a plain list of links to all files in the project. If you create a site-map file, adjust the sorting like this: `:sitemap-sort-folders' Where folders should appear in the site-map. Set this to - `first' (default) or `last' to display folders first or last, - respectively. Any other value will mix files and folders. + `first' or `last' to display folders first or last, + respectively. When set to `ignore' (default), folders are + ignored altogether. Any other value will mix files and + folders. This variable has no effect when site-map style is + `tree'. `:sitemap-sort-files' @@ -285,17 +316,28 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'symbol) -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. +(defcustom org-publish-sitemap-sort-folders 'ignore + "A symbol, denoting if folders are sorted first in site-maps. + +Possible values are `first', `last', `ignore' and nil. If `first', folders will be sorted before files. If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. +If `ignore', folders do not appear in the site-map. +Any other value will mix files and folders. You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." +`org-publish-project-alist', using `:sitemap-sort-folders'. + +This variable is ignored when site-map style is `tree'." :group 'org-export-publish - :type 'symbol) + :type '(choice + (const :tag "Folders before files" first) + (const :tag "Folders after files" last) + (const :tag "No folder in site-map" ignore) + (const :tag "Mix folders and files" nil)) + :version "26.1" + :package-version '(Org . "9.1") + :safe #'symbolp) (defcustom org-publish-sitemap-sort-ignore-case nil "Non-nil when site-map sorting should ignore case. @@ -305,25 +347,8 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'boolean) -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for printing a date in the sitemap. -See `format-time-string' for allowed formatters." - :group 'org-export-publish - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "Format string for site-map file entry. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-export-publish - :type 'string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) @@ -333,7 +358,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 +371,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,17 +384,33 @@ 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)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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-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))))) + (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -377,178 +418,111 @@ This splices all the components into the list." (while (setq p (pop rest)) (if (setq components (plist-get (cdr p) :components)) (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) + (mapcar + (lambda (x) + (or (assoc x org-publish-project-alist) + (user-error "Unknown component %S in project %S" + x (car p)))) + components) rest)) (push p rtn))) (nreverse (delete-dups (delq nil rtn))))) -(defvar org-publish-sitemap-sort-files) -(defvar org-publish-sitemap-sort-folders) -(defvar org-publish-sitemap-ignore-case) -(defvar org-publish-sitemap-requested) -(defvar org-publish-sitemap-date-format) -(defvar org-publish-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (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 - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.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) - (org-publish-find-title b)) b))) - (setq retval (if org-publish-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((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) - (>= 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))) - ;; 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)))))) - retval)) - -(defun org-publish-get-base-files-1 - (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))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-publish-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) "sitemap.org")) - (org-publish-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-publish-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-publish-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-publish-sitemap-sort-folders' has an accepted - ;; value. - (unless (memq org-publish-sitemap-sort-folders '(first last)) - (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)) - 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)) +(defun org-publish-get-base-files (project) + "Return a list of all files in PROJECT." + (let* ((base-dir (file-name-as-directory + (org-publish-property :base-directory project))) + (extension (or (org-publish-property :base-extension project) "org")) + (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))))) + (org-uniquify + (append + ;; Files from BASE-DIR. Apply exclusion filter before adding + ;; included files. + (let ((exclude-regexp (org-publish-property :exclude project))) + (if exclude-regexp + (cl-remove-if + (lambda (f) + ;; Match against relative names, yet BASE-DIR file + ;; names are absolute. + (string-match exclude-regexp + (file-relative-name f base-dir))) + base-files) + base-files)) + ;; Sitemap file. + (and (org-publish-property :auto-sitemap project) + (list (expand-file-name + (or (org-publish-property :sitemap-filename project) + "sitemap.org") + base-dir))) + ;; Included files. + (mapcar (lambda (f) (expand-file-name f base-dir)) + (org-publish-property :include project)))))) (defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." - (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))) + "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)) + (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)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Tools for publishing functions in back-ends (defun org-publish-org-to (backend filename extension plist &optional pub-dir) @@ -567,29 +541,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,268 +575,327 @@ 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)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices +;;; Publishing files, sets of files (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 (org-publish-property :publishing-function project) + (`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 ((plist (cdr project))) + (let ((fun (org-publish-property :preparation-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist)))) + ;; Each project uses its own cache file. + (org-publish-initialize-cache (car project)) + (when (org-publish-property :auto-sitemap project) + (let ((sitemap-filename + (or (org-publish-property :sitemap-filename project) + "sitemap.org"))) + (org-publish-sitemap 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))) - -(defun org-publish-org-sitemap (project &optional sitemap-filename) + (org-publish-property :base-directory project)))) + (dolist (file (org-publish-get-base-files project)) + (unless (file-equal-p file theindex) + (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". + (when (org-publish-property :makeindex project) + (org-publish-index-generate-theindex + project (org-publish-property :base-directory project)) + (org-publish-file theindex project t))) + (let ((fun (org-publish-property :completion-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist))))) + (org-publish-write-cache-file))) + + +;;; Site map generation + +(defun org-publish--sitemap-files-to-lisp (files project style format-entry) + "Represent FILES as a parsed plain list. +FILES is the list of files in the site map. PROJECT is the +current project. STYLE determines is either `list' or `tree'. +FORMAT-ENTRY is a function called on each file which should +return a string. Return value is a list as returned by +`org-list-to-lisp'." + (let ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project))))) + (pcase style + (`list + (cons 'unordered + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + files))) + (`tree + (letrec ((files-only (cl-remove-if #'directory-name-p files)) + (directories (cl-remove-if-not #'directory-name-p files)) + (subtree-to-list + (lambda (dir) + (cons 'unordered + (nconc + ;; Files in DIR. + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + (cl-remove-if-not + (lambda (f) (string= dir (file-name-directory f))) + files-only)) + ;; Direct sub-directories. + (mapcar + (lambda (sub) + (list (funcall format-entry + (file-relative-name sub root) + style + project) + (funcall subtree-to-list sub))) + (cl-remove-if-not + (lambda (f) + (string= + dir + ;; Parent directory. + (file-name-directory (directory-file-name f)))) + directories))))))) + (funcall subtree-to-list root))) + (_ (user-error "Unknown site-map style: `%s'" style))))) + +(defun org-publish-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is `sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) - (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)))) - (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)) - (setq sitemap-buffer - (or visiting (find-file sitemap-filename)))) - (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)) - (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)) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry - org-publish-sitemap-file-entry-format file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec - fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-publish-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) - (with-current-buffer buffer - (let ((title - (let ((property - (plist-get - ;; protect local variables in open buffers - (if visiting - (org-export-with-buffer-copy (org-export-get-environment)) - (org-export-get-environment)) - :title))) - (if property - (org-no-properties (org-element-interpret-data property)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. + (let* ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project)))) + (sitemap-filename (concat root (or sitemap-filename "sitemap.org"))) + (title (or (org-publish-property :sitemap-title project) + (concat "Sitemap for project " (car project)))) + (style (or (org-publish-property :sitemap-style project) + 'tree)) + (sitemap-builder (or (org-publish-property :sitemap-function project) + #'org-publish-sitemap-default)) + (format-entry (or (org-publish-property :sitemap-format-entry project) + #'org-publish-sitemap-default-entry)) + (sort-folders + (org-publish-property :sitemap-sort-folders project + org-publish-sitemap-sort-folders)) + (sort-files + (org-publish-property :sitemap-sort-files project + org-publish-sitemap-sort-files)) + (ignore-case + (org-publish-property :sitemap-ignore-case project + org-publish-sitemap-sort-ignore-case)) + (org-file-p (lambda (f) (equal "org" (file-name-extension f)))) + (sort-predicate + (lambda (a b) + (let ((retval t)) + ;; First we sort files: + (pcase sort-files + (`alphabetically + (let ((A (if (funcall org-file-p a) + (concat (file-name-directory a) + (org-publish-find-title a project)) + a)) + (B (if (funcall org-file-p b) + (concat (file-name-directory b) + (org-publish-find-title b project)) + b))) + (setq retval + (if ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((or `anti-chronologically `chronologically) + (let* ((adate (org-publish-find-date a project)) + (bdate (org-publish-find-date b project)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval + (if (eq sort-files 'chronologically) + (<= A B) + (>= A B))))) + (`nil nil) + (_ (user-error "Invalid sort value %s" sort-files))) + ;; Directory-wise wins: + (when (memq sort-folders '(first last)) + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (eq sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (eq sort-folders 'last))))) + retval)))) + (message "Generating sitemap for %s" title) + (with-temp-file sitemap-filename + (insert + (let ((files (remove sitemap-filename + (org-publish-get-base-files project)))) + ;; Add directories, if applicable. + (unless (and (eq style 'list) (eq sort-folders 'ignore)) + (setq files + (nconc (remove root (org-uniquify + (mapcar #'file-name-directory files))) + files))) + ;; Eventually sort all entries. + (when (or sort-files (not (memq sort-folders 'ignore))) + (setq files (sort files sort-predicate))) + (funcall sitemap-builder + title + (org-publish--sitemap-files-to-lisp + files project style format-entry))))))) + +(defun org-publish-find-property (file property project &optional backend) + "Find the PROPERTY of FILE in project. + +PROPERTY is a keyword referring to an export option, as defined +in `org-export-options-alist' or in export back-ends. In the +latter case, optional argument BACKEND has to be set to the +back-end where the option is defined, e.g., + + (org-publish-find-property file :subtitle 'latex) + +Return value may be a string or a list, depending on the type of +PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." + (let ((file (org-publish--expand-file-name file project))) + (when (and (file-readable-p file) (not (directory-name-p file))) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (plist-get (with-current-buffer buffer + (if (not visiting) (org-export-get-environment backend) + ;; Protect local variables in open buffers. + (org-export-with-buffer-copy + (org-export-get-environment backend)))) + property) + (unless visiting (kill-buffer buffer))))))) + +(defun org-publish-find-title (file project) + "Find the title of FILE in PROJECT." + (let ((file (org-publish--expand-file-name file project))) + (or (org-publish-cache-get-file-property file :title nil t) + (let* ((parsed-title (org-publish-find-property file :title project)) + (title + (if parsed-title + ;; Remove property so that the return value is + ;; cache-able (i.e., it can be `read' back). + (org-no-properties + (org-element-interpret-data parsed-title)) + (file-name-nondirectory (file-name-sans-extension file))))) + (org-publish-cache-set-file-property file :title title) + title)))) + +(defun org-publish-find-date (file project) + "Find the date of FILE in PROJECT. This function assumes FILE is either a directory or an Org file. If FILE is an Org file and provides a DATE keyword use it. In any other case use the file system's modification time. Return time in `current-time' format." - (if (file-directory-p file) (nth 5 (file-attributes file)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (file-buf (or visiting (find-file-noselect file nil))) - (date (plist-get - (with-current-buffer file-buf - (if visiting - (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, - ;; 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)))) - (and ts - (let ((value (org-element-interpret-data ts))) - (and (org-string-nw-p value) - (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) - (t (error "No such file: \"%s\"" file)))))) - + (let ((file (org-publish--expand-file-name file project))) + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let ((date (org-publish-find-property file :date project))) + ;; DATE is a secondary string. If it contains a time-stamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file))))))) + +(defun org-publish-sitemap-default-entry (entry style project) + "Default format for site map ENTRY, as a string. +ENTRY is a file name. STYLE is the style of the sitemap. +PROJECT is the current project." + (cond ((not (directory-name-p entry)) + (format "[[file:%s][%s]]" + entry + (org-publish-find-title entry project))) + ((eq style 'tree) + ;; Return only last subdir. + (file-name-nondirectory (directory-file-name entry))) + (t entry))) + +(defun org-publish-sitemap-default (title list) + "Default site map, as a string. +TITLE is the the title of the site map. LIST is an internal +representation for the files to include, as returned by +`org-list-to-lisp'. PROJECT is the current project." + (concat "#+TITLE: " title "\n\n" + (org-list-to-org list))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions ;;;###autoload @@ -877,25 +912,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 +944,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 +966,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 +992,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 +1007,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 @@ -998,8 +1036,7 @@ its CDR is a string." "Retrieve full index from cache and build \"theindex.org\". PROJECT is the project the index relates to. DIRECTORY is the publishing directory." - (let ((all-files (org-publish-get-base-files - project (plist-get (cdr project) :exclude))) + (let ((all-files (org-publish-get-base-files project)) full-index) ;; Compile full index and sort it alphabetically. (dolist (file all-files @@ -1027,10 +1064,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 +1076,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 +1106,76 @@ 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. + +OUTPUT 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 (org-link-unescape 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)))))) + +(defun org-publish-file-relative-name (filename info) + "Convert FILENAME to be relative to current project's base directory. +INFO is the plist containing the current export state. The +function does not change relative file names." + (let ((base (plist-get info :base-directory))) + (if (and base + (file-name-absolute-p filename) + (file-in-directory-p filename base)) + (file-relative-name filename base) + filename))) @@ -1109,13 +1192,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 +1205,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 +1240,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 +1248,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 +1298,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)) |