lisp/ox-publish.el

   1 ;;; ox-publish.el --- Publish Related Org Mode Files as a Website
   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 (eval-when-compile (require 'cl))
  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 behaviour 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         files)
 372     (when (and (file-exists-p dir) (file-directory-p dir))
 373       (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
 374       (org-publish-reset-cache))))
 375
 376
 377 \f
 378 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 379 ;;; Getting project information out of `org-publish-project-alist'
 380
 381 (defun org-publish-expand-projects (projects-alist)
 382   "Expand projects in PROJECTS-ALIST.
 383 This splices all the components into the list."
 384   (let ((rest projects-alist) rtn p components)
 385     (while (setq p (pop rest))
 386       (if (setq components (plist-get (cdr p) :components))
 387           (setq rest (append
 388                       (mapcar (lambda (x) (assoc x org-publish-project-alist))
 389                               components)
 390                       rest))
 391         (push p rtn)))
 392     (nreverse (delete-dups (delq nil rtn)))))
 393
 394 (defvar org-publish-sitemap-sort-files)
 395 (defvar org-publish-sitemap-sort-folders)
 396 (defvar org-publish-sitemap-ignore-case)
 397 (defvar org-publish-sitemap-requested)
 398 (defvar org-publish-sitemap-date-format)
 399 (defvar org-publish-sitemap-file-entry-format)
 400 (defun org-publish-compare-directory-files (a b)
 401   "Predicate for `sort', that sorts folders and files for sitemap."
 402   (let ((retval t))
 403     (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
 404       ;; First we sort files:
 405       (when org-publish-sitemap-sort-files
 406         (case org-publish-sitemap-sort-files
 407           (alphabetically
 408            (let* ((adir (file-directory-p a))
 409                   (aorg (and (string-match "\\.org$" a) (not adir)))
 410                   (bdir (file-directory-p b))
 411                   (borg (and (string-match "\\.org$" b) (not bdir)))
 412                   (A (if aorg (concat (file-name-directory a)
 413                                       (org-publish-find-title a)) a))
 414                   (B (if borg (concat (file-name-directory b)
 415                                       (org-publish-find-title b)) b)))
 416              (setq retval (if org-publish-sitemap-ignore-case
 417                               (not (string-lessp (upcase B) (upcase A)))
 418                             (not (string-lessp B A))))))
 419           ((anti-chronologically chronologically)
 420            (let* ((adate (org-publish-find-date a))
 421                   (bdate (org-publish-find-date b))
 422                   (A (+ (lsh (car adate) 16) (cadr adate)))
 423                   (B (+ (lsh (car bdate) 16) (cadr bdate))))
 424              (setq retval
 425                    (if (eq org-publish-sitemap-sort-files 'chronologically) (<= 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   (mapc (lambda (f)
 447           (let ((fd-p (file-directory-p f))
 448                 (fnd (file-name-nondirectory f)))
 449             (if (and fd-p recurse
 450                      (not (string-match "^\\.+$" fnd))
 451                      (if skip-dir (not (string-match skip-dir fnd)) t))
 452                 (org-publish-get-base-files-1
 453                  f recurse match skip-file skip-dir)
 454               (unless (or fd-p ;; this is a directory
 455                           (and skip-file (string-match skip-file fnd))
 456                           (not (file-exists-p (file-truename f)))
 457                           (not (string-match match fnd)))
 458
 459                 (pushnew f org-publish-temp-files)))))
 460         (let ((all-files (if (not recurse) (directory-files base-dir t match)
 461                            ;; If RECURSE is non-nil, we want all files
 462                            ;; matching MATCH and sub-directories.
 463                            (org-remove-if-not
 464                             (lambda (file)
 465                               (or (file-directory-p file)
 466                                   (and match (string-match match file))))
 467                             (directory-files base-dir t)))))
 468           (if (not org-publish-sitemap-requested) all-files
 469             (sort all-files 'org-publish-compare-directory-files)))))
 470
 471 (defun org-publish-get-base-files (project &optional exclude-regexp)
 472   "Return a list of all files in PROJECT.
 473 If EXCLUDE-REGEXP is set, this will be used to filter out
 474 matching filenames."
 475   (let* ((project-plist (cdr project))
 476          (base-dir (file-name-as-directory
 477                     (plist-get project-plist :base-directory)))
 478          (include-list (plist-get project-plist :include))
 479          (recurse (plist-get project-plist :recursive))
 480          (extension (or (plist-get project-plist :base-extension) "org"))
 481          ;; sitemap-... variables are dynamically scoped for
 482          ;; org-publish-compare-directory-files:
 483          (org-publish-sitemap-requested
 484           (plist-get project-plist :auto-sitemap))
 485          (sitemap-filename
 486           (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
 487          (org-publish-sitemap-sort-folders
 488           (if (plist-member project-plist :sitemap-sort-folders)
 489               (plist-get project-plist :sitemap-sort-folders)
 490             org-publish-sitemap-sort-folders))
 491          (org-publish-sitemap-sort-files
 492           (cond ((plist-member project-plist :sitemap-sort-files)
 493                  (plist-get project-plist :sitemap-sort-files))
 494                 ;; For backward compatibility:
 495                 ((plist-member project-plist :sitemap-alphabetically)
 496                  (if (plist-get project-plist :sitemap-alphabetically)
 497                      'alphabetically nil))
 498                 (t org-publish-sitemap-sort-files)))
 499          (org-publish-sitemap-ignore-case
 500           (if (plist-member project-plist :sitemap-ignore-case)
 501               (plist-get project-plist :sitemap-ignore-case)
 502             org-publish-sitemap-sort-ignore-case))
 503          (match (if (eq extension 'any) "^[^\\.]"
 504                   (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
 505     ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
 506     ;; value.
 507     (unless (memq org-publish-sitemap-sort-folders '(first last))
 508       (setq org-publish-sitemap-sort-folders nil))
 509
 510     (setq org-publish-temp-files nil)
 511     (if org-publish-sitemap-requested
 512         (pushnew (expand-file-name (concat base-dir sitemap-filename))
 513                   org-publish-temp-files))
 514     (org-publish-get-base-files-1 base-dir recurse match
 515                                   ;; FIXME distinguish exclude regexp
 516                                   ;; for skip-file and skip-dir?
 517                                   exclude-regexp exclude-regexp)
 518     (mapc (lambda (f)
 519             (pushnew
 520              (expand-file-name (concat base-dir f))
 521              org-publish-temp-files))
 522           include-list)
 523     org-publish-temp-files))
 524
 525 (defun org-publish-get-project-from-filename (filename &optional up)
 526   "Return the project that FILENAME belongs to."
 527   (let* ((filename (expand-file-name filename))
 528          project-name)
 529
 530     (catch 'p-found
 531       (dolist (prj org-publish-project-alist)
 532         (unless (plist-get (cdr prj) :components)
 533           ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
 534           (let* ((r (plist-get (cdr prj) :recursive))
 535                  (b (expand-file-name (file-name-as-directory
 536                                        (plist-get (cdr prj) :base-directory))))
 537                  (x (or (plist-get (cdr prj) :base-extension) "org"))
 538                  (e (plist-get (cdr prj) :exclude))
 539                  (i (plist-get (cdr prj) :include))
 540                  (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
 541             (when
 542                 (or (and i
 543                          (member filename
 544                                  (mapcar (lambda (file)
 545                                            (expand-file-name file b))
 546                                          i)))
 547                     (and (not (and e (string-match e filename)))
 548                          (string-match xm filename)))
 549               (setq project-name (car prj))
 550               (throw 'p-found project-name))))))
 551     (when up
 552       (dolist (prj org-publish-project-alist)
 553         (if (member project-name (plist-get (cdr prj) :components))
 554             (setq project-name (car prj)))))
 555     (assoc project-name org-publish-project-alist)))
 556
 557
 558 \f
 559 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 560 ;;; Tools for publishing functions in back-ends
 561
 562 (defun org-publish-org-to (backend filename extension plist &optional pub-dir)
 563   "Publish an Org file to a specified back-end.
 564
 565 BACKEND is a symbol representing the back-end used for
 566 transcoding.  FILENAME is the filename of the Org file to be
 567 published.  EXTENSION is the extension used for the output
 568 string, with the leading dot.  PLIST is the property list for the
 569 given project.
 570
 571 Optional argument PUB-DIR, when non-nil is the publishing
 572 directory.
 573
 574 Return output file name."
 575   (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
 576   ;; Check if a buffer visiting FILENAME is already open.
 577   (let* ((org-inhibit-startup t)
 578          (visitingp (find-buffer-visiting filename))
 579          (work-buffer (or visitingp (find-file-noselect filename))))
 580     (prog1 (with-current-buffer work-buffer
 581              (let ((output-file
 582                     (org-export-output-file-name extension nil pub-dir))
 583                    (body-p (plist-get plist :body-only)))
 584                (org-export-to-file backend output-file
 585                  nil nil nil body-p
 586                  ;; Add `org-publish-collect-numbering' and
 587                  ;; `org-publish-collect-index' to final output
 588                  ;; filters.  The latter isn't dependent on
 589                  ;; `:makeindex', since we want to keep it up-to-date
 590                  ;; in cache anyway.
 591                  (org-combine-plists
 592                   plist
 593                   `(:filter-final-output
 594                     ,(cons 'org-publish-collect-numbering
 595                            (cons 'org-publish-collect-index
 596                                  (plist-get plist :filter-final-output))))))))
 597       ;; Remove opened buffer in the process.
 598       (unless visitingp (kill-buffer work-buffer)))))
 599
 600 (defun org-publish-attachment (plist filename pub-dir)
 601   "Publish a file with no transformation of any kind.
 602
 603 FILENAME is the filename of the Org file to be published.  PLIST
 604 is the property list for the given project.  PUB-DIR is the
 605 publishing directory.
 606
 607 Return output file name."
 608   (unless (file-directory-p pub-dir)
 609     (make-directory pub-dir t))
 610   (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
 611     (or (equal (expand-file-name (file-name-directory filename))
 612                (file-name-as-directory (expand-file-name pub-dir)))
 613         (copy-file filename output t))
 614     ;; Return file name.
 615     output))
 616
 617
 618 \f
 619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 620 ;;; Publishing files, sets of files, and indices
 621
 622 (defun org-publish-file (filename &optional project no-cache)
 623   "Publish file FILENAME from PROJECT.
 624 If NO-CACHE is not nil, do not initialize org-publish-cache and
 625 write it to disk.  This is needed, since this function is used to
 626 publish single files, when entire projects are published.
 627 See `org-publish-projects'."
 628   (let* ((project
 629           (or project
 630               (or (org-publish-get-project-from-filename filename)
 631                   (error "File %s not part of any known project"
 632                          (abbreviate-file-name filename)))))
 633          (project-plist (cdr project))
 634          (ftname (expand-file-name filename))
 635          (publishing-function
 636           (let ((fun (plist-get project-plist :publishing-function)))
 637             (cond ((null fun) (error "No publishing function chosen"))
 638                   ((listp fun) fun)
 639                   (t (list fun)))))
 640          (base-dir
 641           (file-name-as-directory
 642            (expand-file-name
 643             (or (plist-get project-plist :base-directory)
 644                 (error "Project %s does not have :base-directory defined"
 645                        (car project))))))
 646          (pub-dir
 647           (file-name-as-directory
 648            (file-truename
 649             (or (eval (plist-get project-plist :publishing-directory))
 650                 (error "Project %s does not have :publishing-directory defined"
 651                        (car project))))))
 652          tmp-pub-dir)
 653
 654     (unless no-cache (org-publish-initialize-cache (car project)))
 655
 656     (setq tmp-pub-dir
 657           (file-name-directory
 658            (concat pub-dir
 659                    (and (string-match (regexp-quote base-dir) ftname)
 660                         (substring ftname (match-end 0))))))
 661     ;; Allow chain of publishing functions.
 662     (dolist (f publishing-function)
 663       (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
 664         (let ((output (funcall f project-plist filename tmp-pub-dir)))
 665           (org-publish-update-timestamp filename pub-dir f base-dir)
 666           (run-hook-with-args 'org-publish-after-publishing-hook
 667                               filename
 668                               output))))
 669     (unless no-cache (org-publish-write-cache-file))))
 670
 671 (defun org-publish-projects (projects)
 672   "Publish all files belonging to the PROJECTS alist.
 673 If `:auto-sitemap' is set, publish the sitemap too.  If
 674 `:makeindex' is set, also produce a file theindex.org."
 675   (mapc
 676    (lambda (project)
 677      ;; Each project uses its own cache file:
 678      (org-publish-initialize-cache (car project))
 679      (let* ((project-plist (cdr project))
 680             (exclude-regexp (plist-get project-plist :exclude))
 681             (sitemap-p (plist-get project-plist :auto-sitemap))
 682             (sitemap-filename (or (plist-get project-plist :sitemap-filename)
 683                                   "sitemap.org"))
 684             (sitemap-function (or (plist-get project-plist :sitemap-function)
 685                                   'org-publish-org-sitemap))
 686             (org-publish-sitemap-date-format
 687              (or (plist-get project-plist :sitemap-date-format)
 688                  org-publish-sitemap-date-format))
 689             (org-publish-sitemap-file-entry-format
 690              (or (plist-get project-plist :sitemap-file-entry-format)
 691                  org-publish-sitemap-file-entry-format))
 692             (preparation-function
 693              (plist-get project-plist :preparation-function))
 694             (completion-function (plist-get project-plist :completion-function))
 695             (files (org-publish-get-base-files project exclude-regexp))
 696             (theindex
 697              (expand-file-name "theindex.org"
 698                                (plist-get project-plist :base-directory))))
 699        (when preparation-function (run-hooks 'preparation-function))
 700        (if sitemap-p (funcall sitemap-function project sitemap-filename))
 701        ;; Publish all files from PROJECT excepted "theindex.org".  Its
 702        ;; publishing will be deferred until "theindex.inc" is
 703        ;; populated.
 704        (dolist (file files)
 705          (unless (equal file theindex)
 706            (org-publish-file file project t)))
 707        ;; Populate "theindex.inc", if needed, and publish
 708        ;; "theindex.org".
 709        (when (plist-get project-plist :makeindex)
 710          (org-publish-index-generate-theindex
 711           project (plist-get project-plist :base-directory))
 712          (org-publish-file theindex project t))
 713        (when completion-function (run-hooks 'completion-function))
 714        (org-publish-write-cache-file)))
 715    (org-publish-expand-projects projects)))
 716
 717 (defun org-publish-org-sitemap (project &optional sitemap-filename)
 718   "Create a sitemap of pages in set defined by PROJECT.
 719 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 720 Default for SITEMAP-FILENAME is 'sitemap.org'."
 721   (let* ((project-plist (cdr project))
 722          (dir (file-name-as-directory
 723                (plist-get project-plist :base-directory)))
 724          (localdir (file-name-directory dir))
 725          (indent-str (make-string 2 ?\ ))
 726          (exclude-regexp (plist-get project-plist :exclude))
 727          (files (nreverse
 728                  (org-publish-get-base-files project exclude-regexp)))
 729          (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
 730          (sitemap-title (or (plist-get project-plist :sitemap-title)
 731                           (concat "Sitemap for project " (car project))))
 732          (sitemap-style (or (plist-get project-plist :sitemap-style)
 733                             'tree))
 734          (sitemap-sans-extension
 735           (plist-get project-plist :sitemap-sans-extension))
 736          (visiting (find-buffer-visiting sitemap-filename))
 737          (ifn (file-name-nondirectory sitemap-filename))
 738          file sitemap-buffer)
 739     (with-current-buffer
 740         (let ((org-inhibit-startup t))
 741           (setq sitemap-buffer
 742                 (or visiting (find-file sitemap-filename))))
 743       (erase-buffer)
 744       (insert (concat "#+TITLE: " sitemap-title "\n\n"))
 745       (while (setq file (pop files))
 746         (let ((fn (file-name-nondirectory file))
 747               (link (file-relative-name file dir))
 748               (oldlocal localdir))
 749           (when sitemap-sans-extension
 750             (setq link (file-name-sans-extension link)))
 751           ;; sitemap shouldn't list itself
 752           (unless (equal (file-truename sitemap-filename)
 753                          (file-truename file))
 754             (if (eq sitemap-style 'list)
 755                 (message "Generating list-style sitemap for %s" sitemap-title)
 756               (message "Generating tree-style sitemap for %s" sitemap-title)
 757               (setq localdir (concat (file-name-as-directory dir)
 758                                      (file-name-directory link)))
 759               (unless (string= localdir oldlocal)
 760                 (if (string= localdir dir)
 761                     (setq indent-str (make-string 2 ?\ ))
 762                   (let ((subdirs
 763                          (split-string
 764                           (directory-file-name
 765                            (file-name-directory
 766                             (file-relative-name localdir dir))) "/"))
 767                         (subdir "")
 768                         (old-subdirs (split-string
 769                                       (file-relative-name oldlocal dir) "/")))
 770                     (setq indent-str (make-string 2 ?\ ))
 771                     (while (string= (car old-subdirs) (car subdirs))
 772                       (setq indent-str (concat indent-str (make-string 2 ?\ )))
 773                       (pop old-subdirs)
 774                       (pop subdirs))
 775                     (dolist (d subdirs)
 776                       (setq subdir (concat subdir d "/"))
 777                       (insert (concat indent-str " + " d "\n"))
 778                       (setq indent-str (make-string
 779                                         (+ (length indent-str) 2) ?\ )))))))
 780             ;; This is common to 'flat and 'tree
 781             (let ((entry
 782                    (org-publish-format-file-entry
 783                     org-publish-sitemap-file-entry-format file project-plist))
 784                   (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
 785               (cond ((string-match-p regexp entry)
 786                      (string-match regexp entry)
 787                      (insert (concat indent-str " + " (match-string 1 entry)
 788                                      "[[file:" link "]["
 789                                      (match-string 2 entry)
 790                                      "]]" (match-string 3 entry) "\n")))
 791                     (t
 792                      (insert (concat indent-str " + [[file:" link "]["
 793                                      entry
 794                                      "]]\n"))))))))
 795       (save-buffer))
 796     (or visiting (kill-buffer sitemap-buffer))))
 797
 798 (defun org-publish-format-file-entry (fmt file project-plist)
 799   (format-spec
 800    fmt
 801    `((?t . ,(org-publish-find-title file t))
 802      (?d . ,(format-time-string org-publish-sitemap-date-format
 803                                 (org-publish-find-date file)))
 804      (?a . ,(or (plist-get project-plist :author) user-full-name)))))
 805
 806 (defun org-publish-find-title (file &optional reset)
 807   "Find the title of FILE in project."
 808   (or
 809    (and (not reset) (org-publish-cache-get-file-property file :title nil t))
 810    (let* ((org-inhibit-startup t)
 811           (visiting (find-buffer-visiting file))
 812           (buffer (or visiting (find-file-noselect file))))
 813      (with-current-buffer buffer
 814        (let ((title
 815               (let ((property
 816                      (plist-get
 817                       ;; protect local variables in open buffers
 818                       (if visiting
 819                           (org-export-with-buffer-copy (org-export-get-environment))
 820                         (org-export-get-environment))
 821                       :title)))
 822                 (if property
 823                     (org-no-properties (org-element-interpret-data property))
 824                   (file-name-nondirectory (file-name-sans-extension file))))))
 825          (unless visiting (kill-buffer buffer))
 826          (org-publish-cache-set-file-property file :title title)
 827          title)))))
 828
 829 (defun org-publish-find-date (file)
 830   "Find the date of FILE in project.
 831 This function assumes FILE is either a directory or an Org file.
 832 If FILE is an Org file and provides a DATE keyword use it.  In
 833 any other case use the file system's modification time.  Return
 834 time in `current-time' format."
 835   (if (file-directory-p file) (nth 5 (file-attributes file))
 836     (let* ((org-inhibit-startup t)
 837            (visiting (find-buffer-visiting file))
 838            (file-buf (or visiting (find-file-noselect file nil)))
 839            (date (plist-get
 840                   (with-current-buffer file-buf
 841                     (if visiting
 842                         (org-export-with-buffer-copy
 843                          (org-export-get-environment))
 844                       (org-export-get-environment)))
 845                   :date)))
 846       (unless visiting (kill-buffer file-buf))
 847       ;; DATE is a secondary string.  If it contains a timestamp,
 848       ;; convert it to internal format.  Otherwise, use FILE
 849       ;; modification time.
 850       (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
 851                (and ts
 852                     (let ((value (org-element-interpret-data ts)))
 853                       (and (org-string-nw-p value)
 854                            (org-time-string-to-time value))))))
 855             ((file-exists-p file) (nth 5 (file-attributes file)))
 856             (t (error "No such file: \"%s\"" file))))))
 857
 858
 859 \f
 860 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 861 ;;; Interactive publishing functions
 862
 863 ;;;###autoload
 864 (defalias 'org-publish-project 'org-publish)
 865
 866 ;;;###autoload
 867 (defun org-publish (project &optional force async)
 868   "Publish PROJECT.
 869
 870 PROJECT is either a project name, as a string, or a project
 871 alist (see `org-publish-project-alist' variable).
 872
 873 When optional argument FORCE is non-nil, force publishing all
 874 files in PROJECT.  With a non-nil optional argument ASYNC,
 875 publishing will be done asynchronously, in another process."
 876   (interactive
 877    (list (assoc (org-icompleting-read "Publish project: "
 878                                       org-publish-project-alist nil t)
 879                 org-publish-project-alist)
 880          current-prefix-arg))
 881   (let ((project (if (not (stringp project)) project
 882                    ;; If this function is called in batch mode,
 883                    ;; PROJECT is still a string here.
 884                    (assoc project org-publish-project-alist))))
 885     (cond
 886      ((not project))
 887      (async
 888       (org-export-async-start (lambda (results) nil)
 889         `(let ((org-publish-use-timestamps-flag
 890                 ,(and (not force) org-publish-use-timestamps-flag)))
 891            ;; Expand components right now as external process may not
 892            ;; be aware of complete `org-publish-project-alist'.
 893            (org-publish-projects
 894             ',(org-publish-expand-projects (list project))))))
 895      (t (save-window-excursion
 896           (let ((org-publish-use-timestamps-flag
 897                  (and (not force) org-publish-use-timestamps-flag)))
 898             (org-publish-projects (list project))))))))
 899
 900 ;;;###autoload
 901 (defun org-publish-all (&optional force async)
 902   "Publish all projects.
 903 With prefix argument FORCE, remove all files in the timestamp
 904 directory and force publishing all projects.  With a non-nil
 905 optional argument ASYNC, publishing will be done asynchronously,
 906 in another process."
 907   (interactive "P")
 908   (if async
 909       (org-export-async-start (lambda (results) nil)
 910         `(progn
 911            (when ',force (org-publish-remove-all-timestamps))
 912            (let ((org-publish-use-timestamps-flag
 913                   (if ',force nil ,org-publish-use-timestamps-flag)))
 914              (org-publish-projects ',org-publish-project-alist))))
 915     (when force (org-publish-remove-all-timestamps))
 916     (save-window-excursion
 917       (let ((org-publish-use-timestamps-flag
 918              (if force nil org-publish-use-timestamps-flag)))
 919         (org-publish-projects org-publish-project-alist)))))
 920
 921
 922 ;;;###autoload
 923 (defun org-publish-current-file (&optional force async)
 924   "Publish the current file.
 925 With prefix argument FORCE, force publish the file.  When
 926 optional argument ASYNC is non-nil, publishing will be done
 927 asynchronously, in another process."
 928   (interactive "P")
 929   (let ((file (buffer-file-name (buffer-base-buffer))))
 930     (if async
 931         (org-export-async-start (lambda (results) nil)
 932           `(let ((org-publish-use-timestamps-flag
 933                   (if ',force nil ,org-publish-use-timestamps-flag)))
 934              (org-publish-file ,file)))
 935       (save-window-excursion
 936         (let ((org-publish-use-timestamps-flag
 937                (if force nil org-publish-use-timestamps-flag)))
 938           (org-publish-file file))))))
 939
 940 ;;;###autoload
 941 (defun org-publish-current-project (&optional force async)
 942   "Publish the project associated with the current file.
 943 With a prefix argument, force publishing of all files in
 944 the project."
 945   (interactive "P")
 946   (save-window-excursion
 947     (let ((project (org-publish-get-project-from-filename
 948                     (buffer-file-name (buffer-base-buffer)) 'up)))
 949       (if project (org-publish project force async)
 950         (error "File %s is not part of any known project"
 951                (buffer-file-name (buffer-base-buffer)))))))
 952
 953
 954 \f
 955 ;;; Index generation
 956
 957 (defun org-publish-collect-index (output backend info)
 958   "Update index for a file in cache.
 959
 960 OUTPUT is the output from transcoding current file.  BACKEND is
 961 the back-end that was used for transcoding.  INFO is a plist
 962 containing publishing and export options.
 963
 964 The index relative to current file is stored as an alist.  An
 965 association has the following shape: (TERM FILE-NAME PARENT),
 966 where TERM is the indexed term, as a string, FILE-NAME is the
 967 original full path of the file where the term in encountered, and
 968 PARENT is a reference to the headline, if any, containing the
 969 original index keyword.  When non-nil, this reference is a cons
 970 cell.  Its CAR is a symbol among `id', `custom-id' and `name' and
 971 its CDR is a string."
 972   (let ((file (plist-get info :input-file)))
 973     (org-publish-cache-set-file-property
 974      file :index
 975      (delete-dups
 976       (org-element-map (plist-get info :parse-tree) 'keyword
 977         (lambda (k)
 978           (when (equal (org-element-property :key k) "INDEX")
 979             (let ((parent (org-export-get-parent-headline k)))
 980               (list (org-element-property :value k)
 981                     file
 982                     (cond
 983                      ((not parent) nil)
 984                      ((let ((id (org-element-property :ID parent)))
 985                         (and id (cons 'id id))))
 986                      ((let ((id (org-element-property :CUSTOM_ID parent)))
 987                         (and id (cons 'custom-id id))))
 988                      (t (cons 'name
 989                               ;; Remove statistics cookie.
 990                               (replace-regexp-in-string
 991                                "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
 992                                (org-element-property :raw-value parent)))))))))
 993         info))))
 994   ;; Return output unchanged.
 995   output)
 996
 997 (defun org-publish-index-generate-theindex (project directory)
 998   "Retrieve full index from cache and build \"theindex.org\".
 999 PROJECT is the project the index relates to.  DIRECTORY is the
1000 publishing directory."
1001   (let ((all-files (org-publish-get-base-files
1002                     project (plist-get (cdr project) :exclude)))
1003         full-index)
1004     ;; Compile full index and sort it alphabetically.
1005     (dolist (file all-files
1006                   (setq full-index
1007                         (sort (nreverse full-index)
1008                               (lambda (a b) (string< (downcase (car a))
1009                                                 (downcase (car b)))))))
1010       (let ((index (org-publish-cache-get-file-property file :index)))
1011         (dolist (term index)
1012           (unless (member term full-index) (push term full-index)))))
1013     ;; Write "theindex.inc" in DIRECTORY.
1014     (with-temp-file (expand-file-name "theindex.inc" directory)
1015       (let ((current-letter nil) (last-entry nil))
1016         (dolist (idx full-index)
1017           (let* ((entry (org-split-string (car idx) "!"))
1018                  (letter (upcase (substring (car entry) 0 1)))
1019                  ;; Transform file into a path relative to publishing
1020                  ;; directory.
1021                  (file (file-relative-name
1022                         (nth 1 idx)
1023                         (plist-get (cdr project) :base-directory))))
1024             ;; Check if another letter has to be inserted.
1025             (unless (string= letter current-letter)
1026               (insert (format "* %s\n" letter)))
1027             ;; Compute the first difference between last entry and
1028             ;; current one: it tells the level at which new items
1029             ;; should be added.
1030             (let* ((rank (if (equal entry last-entry) (1- (length entry))
1031                            (loop for n from 0 to (length entry)
1032                                  unless (equal (nth n entry) (nth n last-entry))
1033                                  return n)))
1034                    (len (length (nthcdr rank entry))))
1035               ;; For each term after the first difference, create
1036               ;; a new sub-list with the term as body.  Moreover,
1037               ;; linkify the last term.
1038               (dotimes (n len)
1039                 (insert
1040                  (concat
1041                   (make-string (* (+ rank n) 2) ? ) "  - "
1042                   (if (not (= (1- len) n)) (nth (+ rank n) entry)
1043                     ;; Last term: Link it to TARGET, if possible.
1044                     (let ((target (nth 2 idx)))
1045                       (format
1046                        "[[%s][%s]]"
1047                        ;; Destination.
1048                        (case (car target)
1049                          ('nil (format "file:%s" file))
1050                          (id (format "id:%s" (cdr target)))
1051                          (custom-id (format "file:%s::#%s" file (cdr target)))
1052                          (otherwise (format "file:%s::*%s" file (cdr target))))
1053                        ;; Description.
1054                        (car (last entry)))))
1055                   "\n"))))
1056             (setq current-letter letter last-entry entry))))
1057       ;; Create "theindex.org", if it doesn't exist yet, and provide
1058       ;; a default index file.
1059       (let ((index.org (expand-file-name "theindex.org" directory)))
1060         (unless (file-exists-p index.org)
1061           (with-temp-file index.org
1062             (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
1063
1064
1065 \f
1066 ;;; External Fuzzy Links Resolution
1067 ;;
1068 ;; This part implements tools to resolve [[file.org::*Some headline]]
1069 ;; links, where "file.org" belongs to the current project.
1070
1071 (defun org-publish-collect-numbering (output backend info)
1072   (org-publish-cache-set-file-property
1073    (plist-get info :input-file) :numbering
1074    (mapcar (lambda (entry)
1075              (cons (org-split-string
1076                     (replace-regexp-in-string
1077                      "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
1078                      (org-element-property :raw-value (car entry))))
1079                    (cdr entry)))
1080            (plist-get info :headline-numbering)))
1081   ;; Return output unchanged.
1082   output)
1083
1084 (defun org-publish-resolve-external-fuzzy-link (file fuzzy)
1085   "Return numbering for headline matching FUZZY search in FILE.
1086
1087 Return value is a list of numbers, or nil.  This function allows
1088 to resolve external fuzzy links like:
1089
1090   [[file.org::*fuzzy][description]]"
1091   (when org-publish-cache
1092     (cdr (assoc (org-split-string
1093                  (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
1094                 (org-publish-cache-get-file-property
1095                  (expand-file-name file) :numbering nil t)))))
1096
1097
1098 \f
1099 ;;; Caching functions
1100
1101 (defun org-publish-write-cache-file (&optional free-cache)
1102   "Write `org-publish-cache' to file.
1103 If FREE-CACHE, empty the cache."
1104   (unless org-publish-cache
1105     (error "`org-publish-write-cache-file' called, but no cache present"))
1106
1107   (let ((cache-file (org-publish-cache-get ":cache-file:")))
1108     (unless cache-file
1109       (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
1110     (with-temp-file cache-file
1111       (let (print-level print-length)
1112         (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
1113         (maphash (lambda (k v)
1114                    (insert
1115                     (format (concat "(puthash %S "
1116                                     (if (or (listp v) (symbolp v))
1117                                         "'" "")
1118                                     "%S org-publish-cache)\n") k v)))
1119                  org-publish-cache)))
1120     (when free-cache (org-publish-reset-cache))))
1121
1122 (defun org-publish-initialize-cache (project-name)
1123   "Initialize the projects cache if not initialized yet and return it."
1124
1125   (unless project-name
1126     (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
1127
1128   (unless (file-exists-p org-publish-timestamp-directory)
1129     (make-directory org-publish-timestamp-directory t))
1130   (unless (file-directory-p org-publish-timestamp-directory)
1131     (error "Org publish timestamp: %s is not a directory"
1132            org-publish-timestamp-directory))
1133
1134   (unless (and org-publish-cache
1135                (string= (org-publish-cache-get ":project:") project-name))
1136     (let* ((cache-file
1137             (concat
1138              (expand-file-name org-publish-timestamp-directory)
1139              project-name ".cache"))
1140            (cexists (file-exists-p cache-file)))
1141
1142       (when org-publish-cache (org-publish-reset-cache))
1143
1144       (if cexists (load-file cache-file)
1145         (setq org-publish-cache
1146               (make-hash-table :test 'equal :weakness nil :size 100))
1147         (org-publish-cache-set ":project:" project-name)
1148         (org-publish-cache-set ":cache-file:" cache-file))
1149       (unless cexists (org-publish-write-cache-file nil))))
1150   org-publish-cache)
1151
1152 (defun org-publish-reset-cache ()
1153   "Empty org-publish-cache and reset it nil."
1154   (message "%s" "Resetting org-publish-cache")
1155   (when (hash-table-p org-publish-cache)
1156     (clrhash org-publish-cache))
1157   (setq org-publish-cache nil))
1158
1159 (defun org-publish-cache-file-needs-publishing
1160   (filename &optional pub-dir pub-func base-dir)
1161   "Check the timestamp of the last publishing of FILENAME.
1162 Return non-nil if the file needs publishing.  Also check if
1163 any included files have been more recently published, so that
1164 the file including them will be republished as well."
1165   (unless org-publish-cache
1166     (error
1167      "`org-publish-cache-file-needs-publishing' called, but no cache present"))
1168   (let* ((case-fold-search t)
1169          (key (org-publish-timestamp-filename filename pub-dir pub-func))
1170          (pstamp (org-publish-cache-get key))
1171          (org-inhibit-startup t)
1172          (visiting (find-buffer-visiting filename))
1173          included-files-ctime buf)
1174     (when (equal (file-name-extension filename) "org")
1175       (setq buf (find-file (expand-file-name filename)))
1176       (with-current-buffer buf
1177         (goto-char (point-min))
1178         (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
1179           (let* ((element (org-element-at-point))
1180                  (included-file
1181                   (and (eq (org-element-type element) 'keyword)
1182                        (let ((value (org-element-property :value element)))
1183                          (and value
1184                               (string-match "^\\(\".+?\"\\|\\S-+\\)" value)
1185                               (org-remove-double-quotes
1186                                (match-string 1 value)))))))
1187             (when included-file
1188               (add-to-list 'included-files-ctime
1189                            (org-publish-cache-ctime-of-src
1190                             (expand-file-name included-file))
1191                            t)))))
1192       (unless visiting (kill-buffer buf)))
1193     (if (null pstamp) t
1194       (let ((ctime (org-publish-cache-ctime-of-src filename)))
1195         (or (< pstamp ctime)
1196             (when included-files-ctime
1197               (not (null (delq nil (mapcar (lambda (ct) (< ctime ct))
1198                                            included-files-ctime))))))))))
1199
1200 (defun org-publish-cache-set-file-property
1201   (filename property value &optional project-name)
1202   "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
1203 Use cache file of PROJECT-NAME.  If the entry does not exist, it
1204 will be created.  Return VALUE."
1205   ;; Evtl. load the requested cache file:
1206   (if project-name (org-publish-initialize-cache project-name))
1207   (let ((pl (org-publish-cache-get filename)))
1208     (if pl (progn (plist-put pl property value) value)
1209       (org-publish-cache-get-file-property
1210        filename property value nil project-name))))
1211
1212 (defun org-publish-cache-get-file-property
1213   (filename property &optional default no-create project-name)
1214   "Return the value for a PROPERTY of file FILENAME in publishing cache.
1215 Use cache file of PROJECT-NAME. Return the value of that PROPERTY
1216 or DEFAULT, if the value does not yet exist.  If the entry will
1217 be created, unless NO-CREATE is not nil."
1218   ;; Evtl. load the requested cache file:
1219   (if project-name (org-publish-initialize-cache project-name))
1220   (let ((pl (org-publish-cache-get filename)) retval)
1221     (if pl
1222         (if (plist-member pl property)
1223             (setq retval (plist-get pl property))
1224           (setq retval default))
1225       ;; no pl yet:
1226       (unless no-create
1227         (org-publish-cache-set filename (list property default)))
1228       (setq retval default))
1229     retval))
1230
1231 (defun org-publish-cache-get (key)
1232   "Return the value stored in `org-publish-cache' for key KEY.
1233 Returns nil, if no value or nil is found, or the cache does not
1234 exist."
1235   (unless org-publish-cache
1236     (error "`org-publish-cache-get' called, but no cache present"))
1237   (gethash key org-publish-cache))
1238
1239 (defun org-publish-cache-set (key value)
1240   "Store KEY VALUE pair in `org-publish-cache'.
1241 Returns value on success, else nil."
1242   (unless org-publish-cache
1243     (error "`org-publish-cache-set' called, but no cache present"))
1244   (puthash key value org-publish-cache))
1245
1246 (defun org-publish-cache-ctime-of-src (file)
1247   "Get the ctime of FILE as an integer."
1248   (let ((attr (file-attributes
1249                (expand-file-name (or (file-symlink-p file) file)
1250                                  (file-name-directory file)))))
1251     (if (not attr) (error "No such file: \"%s\"" file)
1252       (+ (lsh (car (nth 5 attr)) 16)
1253          (cadr (nth 5 attr))))))
1254
1255
1256 (provide 'ox-publish)
1257
1258 ;; Local variables:
1259 ;; generated-autoload-file: "org-loaddefs.el"
1260 ;; End:
1261
1262 ;;; ox-publish.el ends here