lisp/ox-publish.el

   1 ;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*-
   2 ;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
   3
   4 ;; Author: David O'Toole <dto@gnu.org>
   5 ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
   6 ;; Keywords: hypermedia, outlines, wp
   7
   8 ;; This file is part of GNU Emacs.
   9 ;;
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This program allow configurable publishing of related sets of
  26 ;; Org mode files as a complete website.
  27 ;;
  28 ;; ox-publish.el can do the following:
  29 ;;
  30 ;; + Publish all one's Org files to a given export back-end
  31 ;; + Upload HTML, images, attachments and other files to a web server
  32 ;; + Exclude selected private pages from publishing
  33 ;; + Publish a clickable sitemap of pages
  34 ;; + Manage local timestamps for publishing only changed files
  35 ;; + Accept plugin functions to extend range of publishable content
  36 ;;
  37 ;; Documentation for publishing is in the manual.
  38
  39 ;;; Code:
  40
  41 (require 'cl-lib)
  42 (require 'format-spec)
  43 (require 'ox)
  44
  45
  46 \f
  47 ;;; Variables
  48
  49 (defvar org-publish-temp-files nil
  50   "Temporary list of files to be published.")
  51
  52 ;; Here, so you find the variable right before it's used the first time:
  53 (defvar org-publish-cache nil
  54   "This will cache timestamps and titles for files in publishing projects.
  55 Blocks could hash sha1 values here.")
  56
  57 (defvar org-publish-after-publishing-hook nil
  58   "Hook run each time a file is published.
  59 Every function in this hook will be called with two arguments:
  60 the name of the original file and the name of the file
  61 produced.")
  62
  63 (defgroup org-publish nil
  64   "Options for publishing a set of Org-mode and related files."
  65   :tag "Org Publishing"
  66   :group 'org)
  67
  68 (defcustom org-publish-project-alist nil
  69   "Association list to control publishing behavior.
  70 Each element of the alist is a publishing project.  The CAR of
  71 each element is a string, uniquely identifying the project.  The
  72 CDR of each element is in one of the following forms:
  73
  74 1. A well-formed property list with an even number of elements,
  75    alternating keys and values, specifying parameters for the
  76    publishing process.
  77
  78      (:property value :property value ... )
  79
  80 2. A meta-project definition, specifying of a list of
  81    sub-projects:
  82
  83      (:components (\"project-1\" \"project-2\" ...))
  84
  85 When the CDR of an element of org-publish-project-alist is in
  86 this second form, the elements of the list after `:components'
  87 are taken to be components of the project, which group together
  88 files requiring different publishing options.  When you publish
  89 such a project with \\[org-publish], the components all publish.
  90
  91 When a property is given a value in `org-publish-project-alist',
  92 its setting overrides the value of the corresponding user
  93 variable (if any) during publishing.  However, options set within
  94 a file override everything.
  95
  96 Most properties are optional, but some should always be set:
  97
  98   `:base-directory'
  99
 100     Directory containing publishing source files.
 101
 102   `:base-extension'
 103
 104     Extension (without the dot!) of source files.  This can be
 105     a regular expression.  If not given, \"org\" will be used as
 106     default extension.
 107
 108   `:publishing-directory'
 109
 110     Directory (possibly remote) where output files will be
 111     published.
 112
 113 The `:exclude' property may be used to prevent certain files from
 114 being published.  Its value may be a string or regexp matching
 115 file names you don't want to be published.
 116
 117 The `:include' property may be used to include extra files.  Its
 118 value may be a list of filenames to include.  The filenames are
 119 considered relative to the base directory.
 120
 121 When both `:include' and `:exclude' properties are given values,
 122 the exclusion step happens first.
 123
 124 One special property controls which back-end function to use for
 125 publishing files in the project.  This can be used to extend the
 126 set of file types publishable by `org-publish', as well as the
 127 set of output formats.
 128
 129   `:publishing-function'
 130
 131     Function to publish file.  Each back-end may define its
 132     own (i.e. `org-latex-publish-to-pdf',
 133     `org-html-publish-to-html').  May be a list of functions, in
 134     which case each function in the list is invoked in turn.
 135
 136 Another property allows you to insert code that prepares
 137 a project for publishing.  For example, you could call GNU Make
 138 on a certain makefile, to ensure published files are built up to
 139 date.
 140
 141   `:preparation-function'
 142
 143     Function to be called before publishing this project.  This
 144     may also be a list of functions.
 145
 146   `:completion-function'
 147
 148     Function to be called after publishing this project.  This
 149     may also be a list of functions.
 150
 151 Some properties control details of the Org publishing process,
 152 and are equivalent to the corresponding user variables listed in
 153 the right column.  Back-end specific properties may also be
 154 included.  See the back-end documentation for more information.
 155
 156   :author                   `user-full-name'
 157   :creator                  `org-export-creator-string'
 158   :email                    `user-mail-address'
 159   :exclude-tags             `org-export-exclude-tags'
 160   :headline-levels          `org-export-headline-levels'
 161   :language                 `org-export-default-language'
 162   :preserve-breaks          `org-export-preserve-breaks'
 163   :section-numbers          `org-export-with-section-numbers'
 164   :select-tags              `org-export-select-tags'
 165   :time-stamp-file          `org-export-time-stamp-file'
 166   :with-archived-trees      `org-export-with-archived-trees'
 167   :with-author              `org-export-with-author'
 168   :with-creator             `org-export-with-creator'
 169   :with-date                `org-export-with-date'
 170   :with-drawers             `org-export-with-drawers'
 171   :with-email               `org-export-with-email'
 172   :with-emphasize           `org-export-with-emphasize'
 173   :with-entities            `org-export-with-entities'
 174   :with-fixed-width         `org-export-with-fixed-width'
 175   :with-footnotes           `org-export-with-footnotes'
 176   :with-inlinetasks         `org-export-with-inlinetasks'
 177   :with-latex               `org-export-with-latex'
 178   :with-planning            `org-export-with-planning'
 179   :with-priority            `org-export-with-priority'
 180   :with-properties          `org-export-with-properties'
 181   :with-smart-quotes        `org-export-with-smart-quotes'
 182   :with-special-strings     `org-export-with-special-strings'
 183   :with-statistics-cookies' `org-export-with-statistics-cookies'
 184   :with-sub-superscript     `org-export-with-sub-superscripts'
 185   :with-toc                 `org-export-with-toc'
 186   :with-tables              `org-export-with-tables'
 187   :with-tags                `org-export-with-tags'
 188   :with-tasks               `org-export-with-tasks'
 189   :with-timestamps          `org-export-with-timestamps'
 190   :with-title               `org-export-with-title'
 191   :with-todo-keywords       `org-export-with-todo-keywords'
 192
 193 The following properties may be used to control publishing of
 194 a site-map of files or summary page for a given project.
 195
 196   `:auto-sitemap'
 197
 198     Whether to publish a site-map during
 199     `org-publish-current-project' or `org-publish-all'.
 200
 201   `:sitemap-filename'
 202
 203     Filename for output of sitemap.  Defaults to \"sitemap.org\".
 204
 205   `:sitemap-title'
 206
 207     Title of site-map page.  Defaults to name of file.
 208
 209   `:sitemap-function'
 210
 211     Plugin function to use for generation of site-map.  Defaults
 212     to `org-publish-org-sitemap', which generates a plain list of
 213     links to all files in the project.
 214
 215   `:sitemap-style'
 216
 217     Can be `list' (site-map is just an itemized list of the
 218     titles of the files involved) or `tree' (the directory
 219     structure of the source files is reflected in the site-map).
 220     Defaults to `tree'.
 221
 222   `:sitemap-sans-extension'
 223
 224     Remove extension from site-map's file-names.  Useful to have
 225     cool URIs (see http://www.w3.org/Provider/Style/URI).
 226     Defaults to nil.
 227
 228 If you create a site-map file, adjust the sorting like this:
 229
 230   `:sitemap-sort-folders'
 231
 232     Where folders should appear in the site-map.  Set this to
 233     `first' (default) or `last' to display folders first or last,
 234     respectively.  Any other value will mix files and folders.
 235
 236   `:sitemap-sort-files'
 237
 238     The site map is normally sorted alphabetically.  You can
 239     change this behavior setting this to `anti-chronologically',
 240     `chronologically', or nil.
 241
 242   `:sitemap-ignore-case'
 243
 244     Should sorting be case-sensitive?  Default nil.
 245
 246 The following property control the creation of a concept index.
 247
 248   `:makeindex'
 249
 250     Create a concept index.  The file containing the index has to
 251     be called \"theindex.org\".  If it doesn't exist in the
 252     project, it will be generated.  Contents of the index are
 253     stored in the file \"theindex.inc\", which can be included in
 254     \"theindex.org\".
 255
 256 Other properties affecting publication.
 257
 258   `:body-only'
 259
 260     Set this to t to publish only the body of the documents."
 261   :group 'org-export-publish
 262   :type 'alist)
 263
 264 (defcustom org-publish-use-timestamps-flag t
 265   "Non-nil means use timestamp checking to publish only changed files.
 266 When nil, do no timestamp checking and always publish all files."
 267   :group 'org-export-publish
 268   :type 'boolean)
 269
 270 (defcustom org-publish-timestamp-directory
 271   (convert-standard-filename "~/.org-timestamps/")
 272   "Name of directory in which to store publishing timestamps."
 273   :group 'org-export-publish
 274   :type 'directory)
 275
 276 (defcustom org-publish-list-skipped-files t
 277   "Non-nil means show message about files *not* published."
 278   :group 'org-export-publish
 279   :type 'boolean)
 280
 281 (defcustom org-publish-sitemap-sort-files 'alphabetically
 282   "Method to sort files in site-maps.
 283 Possible values are `alphabetically', `chronologically',
 284 `anti-chronologically' and nil.
 285
 286 If `alphabetically', files will be sorted alphabetically.  If
 287 `chronologically', files will be sorted with older modification
 288 time first.  If `anti-chronologically', files will be sorted with
 289 newer modification time first.  nil won't sort files.
 290
 291 You can overwrite this default per project in your
 292 `org-publish-project-alist', using `:sitemap-sort-files'."
 293   :group 'org-export-publish
 294   :type 'symbol)
 295
 296 (defcustom org-publish-sitemap-sort-folders 'first
 297   "A symbol, denoting if folders are sorted first in sitemaps.
 298 Possible values are `first', `last', and nil.
 299 If `first', folders will be sorted before files.
 300 If `last', folders are sorted to the end after the files.
 301 Any other value will not mix files and folders.
 302
 303 You can overwrite this default per project in your
 304 `org-publish-project-alist', using `:sitemap-sort-folders'."
 305   :group 'org-export-publish
 306   :type 'symbol)
 307
 308 (defcustom org-publish-sitemap-sort-ignore-case nil
 309   "Non-nil when site-map sorting should ignore case.
 310
 311 You can overwrite this default per project in your
 312 `org-publish-project-alist', using `:sitemap-ignore-case'."
 313   :group 'org-export-publish
 314   :type 'boolean)
 315
 316 (defcustom org-publish-sitemap-date-format "%Y-%m-%d"
 317   "Format for printing a date in the sitemap.
 318 See `format-time-string' for allowed formatters."
 319   :group 'org-export-publish
 320   :type 'string)
 321
 322 (defcustom org-publish-sitemap-file-entry-format "%t"
 323   "Format string for site-map file entry.
 324 You could use brackets to delimit on what part the link will be.
 325
 326 %t is the title.
 327 %a is the author.
 328 %d is the date formatted using `org-publish-sitemap-date-format'."
 329   :group 'org-export-publish
 330   :type 'string)
 331
 332
 333 \f
 334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 335 ;;; Timestamp-related functions
 336
 337 (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
 338   "Return path to timestamp file for filename FILENAME."
 339   (setq filename (concat filename "::" (or pub-dir "") "::"
 340                          (format "%s" (or pub-func ""))))
 341   (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
 342
 343 (defun org-publish-needed-p
 344   (filename &optional pub-dir pub-func _true-pub-dir base-dir)
 345   "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
 346 TRUE-PUB-DIR is where the file will truly end up.  Currently we
 347 are not using this - maybe it can eventually be used to check if
 348 the file is present at the target location, and how old it is.
 349 Right now we cannot do this, because we do not know under what
 350 file name the file will be stored - the publishing function can
 351 still decide about that independently."
 352   (let ((rtn (if (not org-publish-use-timestamps-flag) t
 353                (org-publish-cache-file-needs-publishing
 354                 filename pub-dir pub-func base-dir))))
 355     (if rtn (message "Publishing file %s using `%s'" filename pub-func)
 356       (when org-publish-list-skipped-files
 357         (message   "Skipping unmodified file %s" filename)))
 358     rtn))
 359
 360 (defun org-publish-update-timestamp
 361   (filename &optional pub-dir pub-func _base-dir)
 362   "Update publishing timestamp for file FILENAME.
 363 If there is no timestamp, create one."
 364   (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
 365         (stamp (org-publish-cache-ctime-of-src filename)))
 366     (org-publish-cache-set key stamp)))
 367
 368 (defun org-publish-remove-all-timestamps ()
 369   "Remove all files in the timestamp directory."
 370   (let ((dir org-publish-timestamp-directory))
 371     (when (and (file-exists-p dir) (file-directory-p dir))
 372       (mapc #'delete-file (directory-files dir 'full "[^.]\\'"))
 373       (org-publish-reset-cache))))
 374
 375
 376 \f
 377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 378 ;;; Getting project information out of `org-publish-project-alist'
 379
 380 (defun org-publish-expand-projects (projects-alist)
 381   "Expand projects in PROJECTS-ALIST.
 382 This splices all the components into the list."
 383   (let ((rest projects-alist) rtn p components)
 384     (while (setq p (pop rest))
 385       (if (setq components (plist-get (cdr p) :components))
 386           (setq rest (append
 387                       (mapcar (lambda (x) (assoc x org-publish-project-alist))
 388                               components)
 389                       rest))
 390         (push p rtn)))
 391     (nreverse (delete-dups (delq nil rtn)))))
 392
 393 (defvar org-publish-sitemap-sort-files)
 394 (defvar org-publish-sitemap-sort-folders)
 395 (defvar org-publish-sitemap-ignore-case)
 396 (defvar org-publish-sitemap-requested)
 397 (defvar org-publish-sitemap-date-format)
 398 (defvar org-publish-sitemap-file-entry-format)
 399 (defun org-publish-compare-directory-files (a b)
 400   "Predicate for `sort', that sorts folders and files for sitemap."
 401   (let ((retval t))
 402     (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
 403       ;; First we sort files:
 404       (when org-publish-sitemap-sort-files
 405         (pcase org-publish-sitemap-sort-files
 406           (`alphabetically
 407            (let* ((adir (file-directory-p a))
 408                   (aorg (and (string-match "\\.org$" a) (not adir)))
 409                   (bdir (file-directory-p b))
 410                   (borg (and (string-match "\\.org$" b) (not bdir)))
 411                   (A (if aorg (concat (file-name-directory a)
 412                                       (org-publish-find-title a)) a))
 413                   (B (if borg (concat (file-name-directory b)
 414                                       (org-publish-find-title b)) b)))
 415              (setq retval (if org-publish-sitemap-ignore-case
 416                               (not (string-lessp (upcase B) (upcase A)))
 417                             (not (string-lessp B A))))))
 418           ((or `anti-chronologically `chronologically)
 419            (let* ((adate (org-publish-find-date a))
 420                   (bdate (org-publish-find-date b))
 421                   (A (+ (lsh (car adate) 16) (cadr adate)))
 422                   (B (+ (lsh (car bdate) 16) (cadr bdate))))
 423              (setq retval
 424                    (if (eq org-publish-sitemap-sort-files 'chronologically)
 425                        (<= A B)
 426                      (>= A B)))))))
 427       ;; Directory-wise wins:
 428       (when org-publish-sitemap-sort-folders
 429         ;; a is directory, b not:
 430         (cond
 431          ((and (file-directory-p a) (not (file-directory-p b)))
 432           (setq retval (equal org-publish-sitemap-sort-folders 'first)))
 433          ;; a is not a directory, but b is:
 434          ((and (not (file-directory-p a)) (file-directory-p b))
 435           (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
 436     retval))
 437
 438 (defun org-publish-get-base-files-1
 439     (base-dir &optional recurse match skip-file skip-dir)
 440   "Set `org-publish-temp-files' with files from BASE-DIR directory.
 441 If RECURSE is non-nil, check BASE-DIR recursively.  If MATCH is
 442 non-nil, restrict this list to the files matching the regexp
 443 MATCH.  If SKIP-FILE is non-nil, skip file matching the regexp
 444 SKIP-FILE.  If SKIP-DIR is non-nil, don't check directories
 445 matching the regexp SKIP-DIR when recursing through BASE-DIR."
 446   (let ((all-files (if (not recurse) (directory-files base-dir t match)
 447                      ;; If RECURSE is non-nil, we want all files
 448                      ;; matching MATCH and sub-directories.
 449                      (cl-remove-if-not
 450                       (lambda (file)
 451                         (or (file-directory-p file)
 452                             (and match (string-match match file))))
 453                       (directory-files base-dir t)))))
 454     (dolist (f (if (not org-publish-sitemap-requested) all-files
 455                  (sort all-files #'org-publish-compare-directory-files)))
 456       (let ((fd-p (file-directory-p f))
 457             (fnd (file-name-nondirectory f)))
 458         (if (and fd-p recurse
 459                  (not (string-match "^\\.+$" fnd))
 460                  (if skip-dir (not (string-match skip-dir fnd)) t))
 461             (org-publish-get-base-files-1
 462              f recurse match skip-file skip-dir)
 463           (unless (or fd-p              ; This is a directory.
 464                       (and skip-file (string-match skip-file fnd))
 465                       (not (file-exists-p (file-truename f)))
 466                       (not (string-match match fnd)))
 467             (cl-pushnew f org-publish-temp-files)))))))
 468
 469 (defun org-publish-get-base-files (project &optional exclude-regexp)
 470   "Return a list of all files in PROJECT.
 471 If EXCLUDE-REGEXP is set, this will be used to filter out
 472 matching filenames."
 473   (let* ((project-plist (cdr project))
 474          (base-dir (file-name-as-directory
 475                     (plist-get project-plist :base-directory)))
 476          (include-list (plist-get project-plist :include))
 477          (recurse (plist-get project-plist :recursive))
 478          (extension (or (plist-get project-plist :base-extension) "org"))
 479          ;; sitemap-... variables are dynamically scoped for
 480          ;; org-publish-compare-directory-files:
 481          (org-publish-sitemap-requested
 482           (plist-get project-plist :auto-sitemap))
 483          (sitemap-filename
 484           (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
 485          (org-publish-sitemap-sort-folders
 486           (if (plist-member project-plist :sitemap-sort-folders)
 487               (plist-get project-plist :sitemap-sort-folders)
 488             org-publish-sitemap-sort-folders))
 489          (org-publish-sitemap-sort-files
 490           (cond ((plist-member project-plist :sitemap-sort-files)
 491                  (plist-get project-plist :sitemap-sort-files))
 492                 ;; For backward compatibility:
 493                 ((plist-member project-plist :sitemap-alphabetically)
 494                  (if (plist-get project-plist :sitemap-alphabetically)
 495                      'alphabetically nil))
 496                 (t org-publish-sitemap-sort-files)))
 497          (org-publish-sitemap-ignore-case
 498           (if (plist-member project-plist :sitemap-ignore-case)
 499               (plist-get project-plist :sitemap-ignore-case)
 500             org-publish-sitemap-sort-ignore-case))
 501          (match (if (eq extension 'any) "^[^\\.]"
 502                   (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
 503     ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
 504     ;; value.
 505     (unless (memq org-publish-sitemap-sort-folders '(first last))
 506       (setq org-publish-sitemap-sort-folders nil))
 507
 508     (setq org-publish-temp-files nil)
 509     (when org-publish-sitemap-requested
 510       (cl-pushnew (expand-file-name (concat base-dir sitemap-filename))
 511                   org-publish-temp-files))
 512     (org-publish-get-base-files-1 base-dir recurse match
 513                                   ;; FIXME distinguish exclude regexp
 514                                   ;; for skip-file and skip-dir?
 515                                   exclude-regexp exclude-regexp)
 516     (dolist (f include-list org-publish-temp-files)
 517       (cl-pushnew (expand-file-name (concat base-dir f))
 518                   org-publish-temp-files))))
 519
 520 (defun org-publish-get-project-from-filename (filename &optional up)
 521   "Return the project that FILENAME belongs to."
 522   (let* ((filename (expand-file-name filename))
 523          project-name)
 524
 525     (catch 'p-found
 526       (dolist (prj org-publish-project-alist)
 527         (unless (plist-get (cdr prj) :components)
 528           ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
 529           (let* ((r (plist-get (cdr prj) :recursive))
 530                  (b (expand-file-name (file-name-as-directory
 531                                        (plist-get (cdr prj) :base-directory))))
 532                  (x (or (plist-get (cdr prj) :base-extension) "org"))
 533                  (e (plist-get (cdr prj) :exclude))
 534                  (i (plist-get (cdr prj) :include))
 535                  (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
 536             (when
 537                 (or (and i
 538                          (member filename
 539                                  (dolist (file i) (expand-file-name file b))))
 540                     (and (not (and e (string-match e filename)))
 541                          (string-match xm filename)))
 542               (setq project-name (car prj))
 543               (throw 'p-found project-name))))))
 544     (when up
 545       (dolist (prj org-publish-project-alist)
 546         (if (member project-name (plist-get (cdr prj) :components))
 547             (setq project-name (car prj)))))
 548     (assoc project-name org-publish-project-alist)))
 549
 550
 551 \f
 552 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 553 ;;; Tools for publishing functions in back-ends
 554
 555 (defun org-publish-org-to (backend filename extension plist &optional pub-dir)
 556   "Publish an Org file to a specified back-end.
 557
 558 BACKEND is a symbol representing the back-end used for
 559 transcoding.  FILENAME is the filename of the Org file to be
 560 published.  EXTENSION is the extension used for the output
 561 string, with the leading dot.  PLIST is the property list for the
 562 given project.
 563
 564 Optional argument PUB-DIR, when non-nil is the publishing
 565 directory.
 566
 567 Return output file name."
 568   (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
 569   ;; Check if a buffer visiting FILENAME is already open.
 570   (let* ((org-inhibit-startup t)
 571          (visitingp (find-buffer-visiting filename))
 572          (work-buffer (or visitingp (find-file-noselect filename))))
 573     (prog1 (with-current-buffer work-buffer
 574              (let ((output-file
 575                     (org-export-output-file-name extension nil pub-dir))
 576                    (body-p (plist-get plist :body-only)))
 577                (org-export-to-file backend output-file
 578                  nil nil nil body-p
 579                  ;; Add `org-publish--collect-references' and
 580                  ;; `org-publish-collect-index' to final output
 581                  ;; filters.  The latter isn't dependent on
 582                  ;; `:makeindex', since we want to keep it up-to-date
 583                  ;; in cache anyway.
 584                  (org-combine-plists
 585                   plist
 586                   `(:filter-final-output
 587                     ,(cons 'org-publish--collect-references
 588                            (cons 'org-publish-collect-index
 589                                  (plist-get plist :filter-final-output))))))))
 590       ;; Remove opened buffer in the process.
 591       (unless visitingp (kill-buffer work-buffer)))))
 592
 593 (defun org-publish-attachment (_plist filename pub-dir)
 594   "Publish a file with no transformation of any kind.
 595
 596 FILENAME is the filename of the Org file to be published.  PLIST
 597 is the property list for the given project.  PUB-DIR is the
 598 publishing directory.
 599
 600 Return output file name."
 601   (unless (file-directory-p pub-dir)
 602     (make-directory pub-dir t))
 603   (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
 604     (or (equal (expand-file-name (file-name-directory filename))
 605                (file-name-as-directory (expand-file-name pub-dir)))
 606         (copy-file filename output t))
 607     ;; Return file name.
 608     output))
 609
 610
 611 \f
 612 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 613 ;;; Publishing files, sets of files, and indices
 614
 615 (defun org-publish-file (filename &optional project no-cache)
 616   "Publish file FILENAME from PROJECT.
 617 If NO-CACHE is not nil, do not initialize org-publish-cache and
 618 write it to disk.  This is needed, since this function is used to
 619 publish single files, when entire projects are published.
 620 See `org-publish-projects'."
 621   (let* ((project
 622           (or project
 623               (or (org-publish-get-project-from-filename filename)
 624                   (error "File %s not part of any known project"
 625                          (abbreviate-file-name filename)))))
 626          (project-plist (cdr project))
 627          (ftname (expand-file-name filename))
 628          (publishing-function
 629           (let ((fun (plist-get project-plist :publishing-function)))
 630             (cond ((null fun) (error "No publishing function chosen"))
 631                   ((listp fun) fun)
 632                   (t (list fun)))))
 633          (base-dir
 634           (file-name-as-directory
 635            (expand-file-name
 636             (or (plist-get project-plist :base-directory)
 637                 (error "Project %s does not have :base-directory defined"
 638                        (car project))))))
 639          (pub-dir
 640           (file-name-as-directory
 641            (file-truename
 642             (or (eval (plist-get project-plist :publishing-directory))
 643                 (error "Project %s does not have :publishing-directory defined"
 644                        (car project))))))
 645          tmp-pub-dir)
 646
 647     (unless no-cache (org-publish-initialize-cache (car project)))
 648
 649     (setq tmp-pub-dir
 650           (file-name-directory
 651            (concat pub-dir
 652                    (and (string-match (regexp-quote base-dir) ftname)
 653                         (substring ftname (match-end 0))))))
 654     ;; Allow chain of publishing functions.
 655     (dolist (f publishing-function)
 656       (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
 657         (let ((output (funcall f project-plist filename tmp-pub-dir)))
 658           (org-publish-update-timestamp filename pub-dir f base-dir)
 659           (run-hook-with-args 'org-publish-after-publishing-hook
 660                               filename
 661                               output))))
 662     (unless no-cache (org-publish-write-cache-file))))
 663
 664 (defun org-publish-projects (projects)
 665   "Publish all files belonging to the PROJECTS alist.
 666 If `:auto-sitemap' is set, publish the sitemap too.  If
 667 `:makeindex' is set, also produce a file \"theindex.org\"."
 668   (dolist (project (org-publish-expand-projects projects))
 669     (let ((project-plist (cdr project)))
 670       (let ((preparation-function
 671              (plist-get project-plist :preparation-function)))
 672         (when preparation-function (run-hooks 'preparation-function)))
 673       ;; Each project uses its own cache file.
 674       (org-publish-initialize-cache (car project))
 675       (when  (plist-get project-plist :auto-sitemap)
 676         (let ((sitemap-filename
 677                (or (plist-get project-plist :sitemap-filename)
 678                    "sitemap.org"))
 679               (sitemap-function
 680                (or (plist-get project-plist :sitemap-function)
 681                    #'org-publish-org-sitemap))
 682               (org-publish-sitemap-date-format
 683                (or (plist-get project-plist :sitemap-date-format)
 684                    org-publish-sitemap-date-format))
 685               (org-publish-sitemap-file-entry-format
 686                (or (plist-get project-plist :sitemap-file-entry-format)
 687                    org-publish-sitemap-file-entry-format)))
 688           (funcall sitemap-function project sitemap-filename)))
 689       ;; Publish all files from PROJECT excepted "theindex.org".  Its
 690       ;; publishing will be deferred until "theindex.inc" is
 691       ;; populated.
 692       (let ((theindex
 693              (expand-file-name "theindex.org"
 694                                (plist-get project-plist :base-directory)))
 695             (exclude-regexp (plist-get project-plist :exclude)))
 696         (dolist (file (org-publish-get-base-files project exclude-regexp))
 697           (unless (equal file theindex) (org-publish-file file project t)))
 698         ;; Populate "theindex.inc", if needed, and publish
 699         ;; "theindex.org".
 700         (when (plist-get project-plist :makeindex)
 701           (org-publish-index-generate-theindex
 702            project (plist-get project-plist :base-directory))
 703           (org-publish-file theindex project t)))
 704       (let ((completion-function
 705              (plist-get project-plist :completion-function)))
 706         (when completion-function (run-hooks 'completion-function)))
 707       (org-publish-write-cache-file))))
 708
 709 (defun org-publish-org-sitemap (project &optional sitemap-filename)
 710   "Create a sitemap of pages in set defined by PROJECT.
 711 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 712 Default for SITEMAP-FILENAME is `sitemap.org'."
 713   (let* ((project-plist (cdr project))
 714          (dir (file-name-as-directory
 715                (plist-get project-plist :base-directory)))
 716          (localdir (file-name-directory dir))
 717          (indent-str (make-string 2 ?\ ))
 718          (exclude-regexp (plist-get project-plist :exclude))
 719          (files (nreverse
 720                  (org-publish-get-base-files project exclude-regexp)))
 721          (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
 722          (sitemap-title (or (plist-get project-plist :sitemap-title)
 723                           (concat "Sitemap for project " (car project))))
 724          (sitemap-style (or (plist-get project-plist :sitemap-style)
 725                             'tree))
 726          (sitemap-sans-extension
 727           (plist-get project-plist :sitemap-sans-extension))
 728          (visiting (find-buffer-visiting sitemap-filename))
 729          file sitemap-buffer)
 730     (with-current-buffer
 731         (let ((org-inhibit-startup t))
 732           (setq sitemap-buffer
 733                 (or visiting (find-file sitemap-filename))))
 734       (erase-buffer)
 735       (insert (concat "#+TITLE: " sitemap-title "\n\n"))
 736       (while (setq file (pop files))
 737         (let ((link (file-relative-name file dir))
 738               (oldlocal localdir))
 739           (when sitemap-sans-extension
 740             (setq link (file-name-sans-extension link)))
 741           ;; sitemap shouldn't list itself
 742           (unless (equal (file-truename sitemap-filename)
 743                          (file-truename file))
 744             (if (eq sitemap-style 'list)
 745                 (message "Generating list-style sitemap for %s" sitemap-title)
 746               (message "Generating tree-style sitemap for %s" sitemap-title)
 747               (setq localdir (concat (file-name-as-directory dir)
 748                                      (file-name-directory link)))
 749               (unless (string= localdir oldlocal)
 750                 (if (string= localdir dir)
 751                     (setq indent-str (make-string 2 ?\ ))
 752                   (let ((subdirs
 753                          (split-string
 754                           (directory-file-name
 755                            (file-name-directory
 756                             (file-relative-name localdir dir))) "/"))
 757                         (subdir "")
 758                         (old-subdirs (split-string
 759                                       (file-relative-name oldlocal dir) "/")))
 760                     (setq indent-str (make-string 2 ?\ ))
 761                     (while (string= (car old-subdirs) (car subdirs))
 762                       (setq indent-str (concat indent-str (make-string 2 ?\ )))
 763                       (pop old-subdirs)
 764                       (pop subdirs))
 765                     (dolist (d subdirs)
 766                       (setq subdir (concat subdir d "/"))
 767                       (insert (concat indent-str " + " d "\n"))
 768                       (setq indent-str (make-string
 769                                         (+ (length indent-str) 2) ?\ )))))))
 770             ;; This is common to 'flat and 'tree
 771             (let ((entry
 772                    (org-publish-format-file-entry
 773                     org-publish-sitemap-file-entry-format file project-plist))
 774                   (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
 775               (cond ((string-match-p regexp entry)
 776                      (string-match regexp entry)
 777                      (insert (concat indent-str " + " (match-string 1 entry)
 778                                      "[[file:" link "]["
 779                                      (match-string 2 entry)
 780                                      "]]" (match-string 3 entry) "\n")))
 781                     (t
 782                      (insert (concat indent-str " + [[file:" link "]["
 783                                      entry
 784                                      "]]\n"))))))))
 785       (save-buffer))
 786     (or visiting (kill-buffer sitemap-buffer))))
 787
 788 (defun org-publish-format-file-entry (fmt file project-plist)
 789   (format-spec
 790    fmt
 791    `((?t . ,(org-publish-find-title file t))
 792      (?d . ,(format-time-string org-publish-sitemap-date-format
 793                                 (org-publish-find-date file)))
 794      (?a . ,(or (plist-get project-plist :author) user-full-name)))))
 795
 796 (defun org-publish-find-title (file &optional reset)
 797   "Find the title of FILE in project."
 798   (or
 799    (and (not reset) (org-publish-cache-get-file-property file :title nil t))
 800    (let* ((org-inhibit-startup t)
 801           (visiting (find-buffer-visiting file))
 802           (buffer (or visiting (find-file-noselect file))))
 803      (with-current-buffer buffer
 804        (let ((title
 805               (let ((property
 806                      (plist-get
 807                       ;; protect local variables in open buffers
 808                       (if visiting
 809                           (org-export-with-buffer-copy (org-export-get-environment))
 810                         (org-export-get-environment))
 811                       :title)))
 812                 (if property
 813                     (org-no-properties (org-element-interpret-data property))
 814                   (file-name-nondirectory (file-name-sans-extension file))))))
 815          (unless visiting (kill-buffer buffer))
 816          (org-publish-cache-set-file-property file :title title)
 817          title)))))
 818
 819 (defun org-publish-find-date (file)
 820   "Find the date of FILE in project.
 821 This function assumes FILE is either a directory or an Org file.
 822 If FILE is an Org file and provides a DATE keyword use it.  In
 823 any other case use the file system's modification time.  Return
 824 time in `current-time' format."
 825   (if (file-directory-p file) (nth 5 (file-attributes file))
 826     (let* ((org-inhibit-startup t)
 827            (visiting (find-buffer-visiting file))
 828            (file-buf (or visiting (find-file-noselect file nil)))
 829            (date (plist-get
 830                   (with-current-buffer file-buf
 831                     (if visiting
 832                         (org-export-with-buffer-copy
 833                          (org-export-get-environment))
 834                       (org-export-get-environment)))
 835                   :date)))
 836       (unless visiting (kill-buffer file-buf))
 837       ;; DATE is a secondary string.  If it contains a timestamp,
 838       ;; convert it to internal format.  Otherwise, use FILE
 839       ;; modification time.
 840       (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
 841                (and ts
 842                     (let ((value (org-element-interpret-data ts)))
 843                       (and (org-string-nw-p value)
 844                            (org-time-string-to-time value))))))
 845             ((file-exists-p file) (nth 5 (file-attributes file)))
 846             (t (error "No such file: \"%s\"" file))))))
 847
 848
 849 \f
 850 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 851 ;;; Interactive publishing functions
 852
 853 ;;;###autoload
 854 (defalias 'org-publish-project 'org-publish)
 855
 856 ;;;###autoload
 857 (defun org-publish (project &optional force async)
 858   "Publish PROJECT.
 859
 860 PROJECT is either a project name, as a string, or a project
 861 alist (see `org-publish-project-alist' variable).
 862
 863 When optional argument FORCE is non-nil, force publishing all
 864 files in PROJECT.  With a non-nil optional argument ASYNC,
 865 publishing will be done asynchronously, in another process."
 866   (interactive
 867    (list (assoc (org-icompleting-read "Publish project: "
 868                                       org-publish-project-alist nil t)
 869                 org-publish-project-alist)
 870          current-prefix-arg))
 871   (let ((project (if (not (stringp project)) project
 872                    ;; If this function is called in batch mode,
 873                    ;; PROJECT is still a string here.
 874                    (assoc project org-publish-project-alist))))
 875     (cond
 876      ((not project))
 877      (async
 878       (org-export-async-start (lambda (_) nil)
 879         `(let ((org-publish-use-timestamps-flag
 880                 ,(and (not force) org-publish-use-timestamps-flag)))
 881            ;; Expand components right now as external process may not
 882            ;; be aware of complete `org-publish-project-alist'.
 883            (org-publish-projects
 884             ',(org-publish-expand-projects (list project))))))
 885      (t (save-window-excursion
 886           (let ((org-publish-use-timestamps-flag
 887                  (and (not force) org-publish-use-timestamps-flag)))
 888             (org-publish-projects (list project))))))))
 889
 890 ;;;###autoload
 891 (defun org-publish-all (&optional force async)
 892   "Publish all projects.
 893 With prefix argument FORCE, remove all files in the timestamp
 894 directory and force publishing all projects.  With a non-nil
 895 optional argument ASYNC, publishing will be done asynchronously,
 896 in another process."
 897   (interactive "P")
 898   (if async
 899       (org-export-async-start (lambda (_) nil)
 900         `(progn
 901            (when ',force (org-publish-remove-all-timestamps))
 902            (let ((org-publish-use-timestamps-flag
 903                   (if ',force nil ,org-publish-use-timestamps-flag)))
 904              (org-publish-projects ',org-publish-project-alist))))
 905     (when force (org-publish-remove-all-timestamps))
 906     (save-window-excursion
 907       (let ((org-publish-use-timestamps-flag
 908              (if force nil org-publish-use-timestamps-flag)))
 909         (org-publish-projects org-publish-project-alist)))))
 910
 911
 912 ;;;###autoload
 913 (defun org-publish-current-file (&optional force async)
 914   "Publish the current file.
 915 With prefix argument FORCE, force publish the file.  When
 916 optional argument ASYNC is non-nil, publishing will be done
 917 asynchronously, in another process."
 918   (interactive "P")
 919   (let ((file (buffer-file-name (buffer-base-buffer))))
 920     (if async
 921         (org-export-async-start (lambda (_) nil)
 922           `(let ((org-publish-use-timestamps-flag
 923                   (if ',force nil ,org-publish-use-timestamps-flag)))
 924              (org-publish-file ,file)))
 925       (save-window-excursion
 926         (let ((org-publish-use-timestamps-flag
 927                (if force nil org-publish-use-timestamps-flag)))
 928           (org-publish-file file))))))
 929
 930 ;;;###autoload
 931 (defun org-publish-current-project (&optional force async)
 932   "Publish the project associated with the current file.
 933 With a prefix argument, force publishing of all files in
 934 the project."
 935   (interactive "P")
 936   (save-window-excursion
 937     (let ((project (org-publish-get-project-from-filename
 938                     (buffer-file-name (buffer-base-buffer)) 'up)))
 939       (if project (org-publish project force async)
 940         (error "File %s is not part of any known project"
 941                (buffer-file-name (buffer-base-buffer)))))))
 942
 943
 944 \f
 945 ;;; Index generation
 946
 947 (defun org-publish-collect-index (output _backend info)
 948   "Update index for a file in cache.
 949
 950 OUTPUT is the output from transcoding current file.  BACKEND is
 951 the back-end that was used for transcoding.  INFO is a plist
 952 containing publishing and export options.
 953
 954 The index relative to current file is stored as an alist.  An
 955 association has the following shape: (TERM FILE-NAME PARENT),
 956 where TERM is the indexed term, as a string, FILE-NAME is the
 957 original full path of the file where the term in encountered, and
 958 PARENT is a reference to the headline, if any, containing the
 959 original index keyword.  When non-nil, this reference is a cons
 960 cell.  Its CAR is a symbol among `id', `custom-id' and `name' and
 961 its CDR is a string."
 962   (let ((file (plist-get info :input-file)))
 963     (org-publish-cache-set-file-property
 964      file :index
 965      (delete-dups
 966       (org-element-map (plist-get info :parse-tree) 'keyword
 967         (lambda (k)
 968           (when (equal (org-element-property :key k) "INDEX")
 969             (let ((parent (org-export-get-parent-headline k)))
 970               (list (org-element-property :value k)
 971                     file
 972                     (cond
 973                      ((not parent) nil)
 974                      ((let ((id (org-element-property :ID parent)))
 975                         (and id (cons 'id id))))
 976                      ((let ((id (org-element-property :CUSTOM_ID parent)))
 977                         (and id (cons 'custom-id id))))
 978                      (t (cons 'name
 979                               ;; Remove statistics cookie.
 980                               (replace-regexp-in-string
 981                                "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
 982                                (org-element-property :raw-value parent)))))))))
 983         info))))
 984   ;; Return output unchanged.
 985   output)
 986
 987 (defun org-publish-index-generate-theindex (project directory)
 988   "Retrieve full index from cache and build \"theindex.org\".
 989 PROJECT is the project the index relates to.  DIRECTORY is the
 990 publishing directory."
 991   (let ((all-files (org-publish-get-base-files
 992                     project (plist-get (cdr project) :exclude)))
 993         full-index)
 994     ;; Compile full index and sort it alphabetically.
 995     (dolist (file all-files
 996                   (setq full-index
 997                         (sort (nreverse full-index)
 998                               (lambda (a b) (string< (downcase (car a))
 999                                                 (downcase (car b)))))))
1000       (let ((index (org-publish-cache-get-file-property file :index)))
1001         (dolist (term index)
1002           (unless (member term full-index) (push term full-index)))))
1003     ;; Write "theindex.inc" in DIRECTORY.
1004     (with-temp-file (expand-file-name "theindex.inc" directory)
1005       (let ((current-letter nil) (last-entry nil))
1006         (dolist (idx full-index)
1007           (let* ((entry (org-split-string (car idx) "!"))
1008                  (letter (upcase (substring (car entry) 0 1)))
1009                  ;; Transform file into a path relative to publishing
1010                  ;; directory.
1011                  (file (file-relative-name
1012                         (nth 1 idx)
1013                         (plist-get (cdr project) :base-directory))))
1014             ;; Check if another letter has to be inserted.
1015             (unless (string= letter current-letter)
1016               (insert (format "* %s\n" letter)))
1017             ;; Compute the first difference between last entry and
1018             ;; current one: it tells the level at which new items
1019             ;; should be added.
1020             (let* ((rank
1021                     (if (equal entry last-entry) (1- (length entry))
1022                       (cl-loop for n from 0 to (length entry)
1023                                unless (equal (nth n entry) (nth n last-entry))
1024                                return n)))
1025                    (len (length (nthcdr rank entry))))
1026               ;; For each term after the first difference, create
1027               ;; a new sub-list with the term as body.  Moreover,
1028               ;; linkify the last term.
1029               (dotimes (n len)
1030                 (insert
1031                  (concat
1032                   (make-string (* (+ rank n) 2) ? ) "  - "
1033                   (if (not (= (1- len) n)) (nth (+ rank n) entry)
1034                     ;; Last term: Link it to TARGET, if possible.
1035                     (let ((target (nth 2 idx)))
1036                       (format
1037                        "[[%s][%s]]"
1038                        ;; Destination.
1039                        (pcase (car target)
1040                          (`nil (format "file:%s" file))
1041                          (`id (format "id:%s" (cdr target)))
1042                          (`custom-id (format "file:%s::#%s" file (cdr target)))
1043                          (_ (format "file:%s::*%s" file (cdr target))))
1044                        ;; Description.
1045                        (car (last entry)))))
1046                   "\n"))))
1047             (setq current-letter letter last-entry entry))))
1048       ;; Create "theindex.org", if it doesn't exist yet, and provide
1049       ;; a default index file.
1050       (let ((index.org (expand-file-name "theindex.org" directory)))
1051         (unless (file-exists-p index.org)
1052           (with-temp-file index.org
1053             (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
1054
1055
1056 \f
1057 ;;; External Fuzzy Links Resolution
1058 ;;
1059 ;; This part implements tools to resolve [[file.org::*Some headline]]
1060 ;; links, where "file.org" belongs to the current project.
1061
1062 (defun org-publish--collect-references (output _backend info)
1063   "Store references for current published file.
1064
1065 OUPUT is the produced output, as a string.  BACKEND is the export
1066 back-end used, as a symbol.  INFO is the final export state, as
1067 a plist.
1068
1069 References are stored as an alist ((TYPE SEARCH) . VALUE) where
1070
1071   TYPE is a symbol among `headline', `custom-id', `target' and
1072   `other'.
1073
1074   SEARCH is the string a link is expected to match.  It is
1075
1076     - headline's title, as a string, with all whitespace
1077       characters and statistics cookies removed, if TYPE is
1078       `headline'.
1079
1080     - CUSTOM_ID value if TYPE is `custom-id'.
1081
1082     - target's or radio-target's name if TYPE is `target'.
1083
1084     - NAME affiliated keyword is TYPE is `other'.
1085
1086   VALUE is an internal reference used in the document, as
1087   a string.
1088
1089 This function is meant to be used as a final output filter.  See
1090 `org-publish-org-to'."
1091   (org-publish-cache-set-file-property
1092    (plist-get info :input-file) :references
1093    (let (refs)
1094      (when (hash-table-p (plist-get info :internal-references))
1095        (maphash
1096         (lambda (k v)
1097           (pcase (org-element-type k)
1098             (`nil nil)
1099             ((or `headline `inlinetask)
1100              (push (cons
1101                     (cons 'headline
1102                           (org-split-string
1103                            (replace-regexp-in-string
1104                             "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
1105                             (org-element-property :raw-value k))))
1106                     v)
1107                    refs)
1108              (let ((custom-id (org-element-property :CUSTOM_ID k)))
1109                (when custom-id
1110                  (push (cons (cons 'custom-id custom-id) v) refs))))
1111             ((or `radio-target `target)
1112              (push
1113               (cons (cons 'target
1114                           (org-split-string (org-element-property :value k)))
1115                     v)
1116               refs))
1117             ((and (let name (org-element-property :name k))
1118                   (guard name))
1119              (push (cons (cons 'other (org-split-string name)) v)
1120                    refs)))
1121           refs)
1122         (plist-get info :internal-references)))
1123      refs))
1124   ;; Return output unchanged.
1125   output)
1126
1127 (defun org-publish-resolve-external-link (search file)
1128   "Return reference for elements or objects matching SEARCH in FILE.
1129
1130 Return value is an internal reference, as a string.
1131
1132 This function allows to resolve external links like:
1133
1134   [[file.org::*fuzzy][description]]
1135   [[file.org::#custom-id][description]]
1136   [[file.org::fuzzy][description]]"
1137   (if (not org-publish-cache)
1138       (progn
1139         (message "Reference \"%s\" in file \"%s\" cannot be resolved without \
1140 publishing"
1141                  search
1142                  file)
1143         "MissingReference")
1144     (let ((references (org-publish-cache-get-file-property
1145                        (expand-file-name file) :references nil t)))
1146       (cond
1147        ((cdr (pcase (aref search 0)
1148                (?* (assoc (cons 'headline (org-split-string (substring search 1)))
1149                           references))
1150                (?# (assoc (cons 'custom-id (substring search 1)) references))
1151                (_
1152                 (let ((s (org-split-string search)))
1153                   (or (assoc (cons 'target s) references)
1154                       (assoc (cons 'other s) references)
1155                       (assoc (cons 'headline s) references)))))))
1156        (t (message "Unknown cross-reference \"%s\" in file \"%s\"" search file)
1157           "MissingReference")))))
1158
1159
1160 \f
1161 ;;; Caching functions
1162
1163 (defun org-publish-write-cache-file (&optional free-cache)
1164   "Write `org-publish-cache' to file.
1165 If FREE-CACHE, empty the cache."
1166   (unless org-publish-cache
1167     (error "`org-publish-write-cache-file' called, but no cache present"))
1168
1169   (let ((cache-file (org-publish-cache-get ":cache-file:")))
1170     (unless cache-file
1171       (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
1172     (with-temp-file cache-file
1173       (let (print-level print-length)
1174         (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
1175         (maphash (lambda (k v)
1176                    (insert
1177                     (format (concat "(puthash %S "
1178                                     (if (or (listp v) (symbolp v))
1179                                         "'" "")
1180                                     "%S org-publish-cache)\n") k v)))
1181                  org-publish-cache)))
1182     (when free-cache (org-publish-reset-cache))))
1183
1184 (defun org-publish-initialize-cache (project-name)
1185   "Initialize the projects cache if not initialized yet and return it."
1186
1187   (unless project-name
1188     (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
1189
1190   (unless (file-exists-p org-publish-timestamp-directory)
1191     (make-directory org-publish-timestamp-directory t))
1192   (unless (file-directory-p org-publish-timestamp-directory)
1193     (error "Org publish timestamp: %s is not a directory"
1194            org-publish-timestamp-directory))
1195
1196   (unless (and org-publish-cache
1197                (string= (org-publish-cache-get ":project:") project-name))
1198     (let* ((cache-file
1199             (concat
1200              (expand-file-name org-publish-timestamp-directory)
1201              project-name ".cache"))
1202            (cexists (file-exists-p cache-file)))
1203
1204       (when org-publish-cache (org-publish-reset-cache))
1205
1206       (if cexists (load-file cache-file)
1207         (setq org-publish-cache
1208               (make-hash-table :test 'equal :weakness nil :size 100))
1209         (org-publish-cache-set ":project:" project-name)
1210         (org-publish-cache-set ":cache-file:" cache-file))
1211       (unless cexists (org-publish-write-cache-file nil))))
1212   org-publish-cache)
1213
1214 (defun org-publish-reset-cache ()
1215   "Empty org-publish-cache and reset it nil."
1216   (message "%s" "Resetting org-publish-cache")
1217   (when (hash-table-p org-publish-cache)
1218     (clrhash org-publish-cache))
1219   (setq org-publish-cache nil))
1220
1221 (defun org-publish-cache-file-needs-publishing
1222     (filename &optional pub-dir pub-func _base-dir)
1223   "Check the timestamp of the last publishing of FILENAME.
1224 Return non-nil if the file needs publishing.  Also check if
1225 any included files have been more recently published, so that
1226 the file including them will be republished as well."
1227   (unless org-publish-cache
1228     (error
1229      "`org-publish-cache-file-needs-publishing' called, but no cache present"))
1230   (let* ((case-fold-search t)
1231          (key (org-publish-timestamp-filename filename pub-dir pub-func))
1232          (pstamp (org-publish-cache-get key))
1233          (org-inhibit-startup t)
1234          (visiting (find-buffer-visiting filename))
1235          included-files-ctime buf)
1236     (when (equal (file-name-extension filename) "org")
1237       (setq buf (find-file (expand-file-name filename)))
1238       (with-current-buffer buf
1239         (goto-char (point-min))
1240         (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
1241           (let* ((element (org-element-at-point))
1242                  (included-file
1243                   (and (eq (org-element-type element) 'keyword)
1244                        (let ((value (org-element-property :value element)))
1245                          (and value
1246                               (string-match "^\\(\".+?\"\\|\\S-+\\)" value)
1247                               (org-remove-double-quotes
1248                                (match-string 1 value)))))))
1249             (when included-file
1250               (push (org-publish-cache-ctime-of-src
1251                      (expand-file-name included-file))
1252                     included-files-ctime)))))
1253       (unless visiting (kill-buffer buf)))
1254     (or (null pstamp)
1255         (let ((ctime (org-publish-cache-ctime-of-src filename)))
1256           (or (< pstamp ctime)
1257               (cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
1258
1259 (defun org-publish-cache-set-file-property
1260   (filename property value &optional project-name)
1261   "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
1262 Use cache file of PROJECT-NAME.  If the entry does not exist, it
1263 will be created.  Return VALUE."
1264   ;; Evtl. load the requested cache file:
1265   (if project-name (org-publish-initialize-cache project-name))
1266   (let ((pl (org-publish-cache-get filename)))
1267     (if pl (progn (plist-put pl property value) value)
1268       (org-publish-cache-get-file-property
1269        filename property value nil project-name))))
1270
1271 (defun org-publish-cache-get-file-property
1272   (filename property &optional default no-create project-name)
1273   "Return the value for a PROPERTY of file FILENAME in publishing cache.
1274 Use cache file of PROJECT-NAME. Return the value of that PROPERTY
1275 or DEFAULT, if the value does not yet exist.  If the entry will
1276 be created, unless NO-CREATE is not nil."
1277   ;; Evtl. load the requested cache file:
1278   (if project-name (org-publish-initialize-cache project-name))
1279   (let ((pl (org-publish-cache-get filename)) retval)
1280     (if pl
1281         (if (plist-member pl property)
1282             (setq retval (plist-get pl property))
1283           (setq retval default))
1284       ;; no pl yet:
1285       (unless no-create
1286         (org-publish-cache-set filename (list property default)))
1287       (setq retval default))
1288     retval))
1289
1290 (defun org-publish-cache-get (key)
1291   "Return the value stored in `org-publish-cache' for key KEY.
1292 Returns nil, if no value or nil is found, or the cache does not
1293 exist."
1294   (unless org-publish-cache
1295     (error "`org-publish-cache-get' called, but no cache present"))
1296   (gethash key org-publish-cache))
1297
1298 (defun org-publish-cache-set (key value)
1299   "Store KEY VALUE pair in `org-publish-cache'.
1300 Returns value on success, else nil."
1301   (unless org-publish-cache
1302     (error "`org-publish-cache-set' called, but no cache present"))
1303   (puthash key value org-publish-cache))
1304
1305 (defun org-publish-cache-ctime-of-src (file)
1306   "Get the ctime of FILE as an integer."
1307   (let ((attr (file-attributes
1308                (expand-file-name (or (file-symlink-p file) file)
1309                                  (file-name-directory file)))))
1310     (if (not attr) (error "No such file: \"%s\"" file)
1311       (+ (lsh (car (nth 5 attr)) 16)
1312          (cadr (nth 5 attr))))))
1313
1314
1315 (provide 'ox-publish)
1316
1317 ;; Local variables:
1318 ;; generated-autoload-file: "org-loaddefs.el"
1319 ;; End:
1320
1321 ;;; ox-publish.el ends here