lisp/ox-publish.el

   1 ;;; ox-publish.el --- Publish Related Org Mode Files as a Website
   2 ;; Copyright (C) 2006-2014 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-priority            `org-export-with-priority'
 179   :with-properties          `org-export-with-properties'
 180   :with-smart-quotes        `org-export-with-smart-quotes'
 181   :with-special-strings     `org-export-with-special-strings'
 182   :with-statistics-cookies' `org-export-with-statistics-cookies'
 183   :with-sub-superscript     `org-export-with-sub-superscripts'
 184   :with-toc                 `org-export-with-toc'
 185   :with-tables              `org-export-with-tables'
 186   :with-tags                `org-export-with-tags'
 187   :with-tasks               `org-export-with-tasks'
 188   :with-timestamps          `org-export-with-timestamps'
 189   :with-planning            `org-export-with-planning'
 190   :with-todo-keywords       `org-export-with-todo-keywords'
 191
 192 The following properties may be used to control publishing of
 193 a site-map of files or summary page for a given project.
 194
 195   `:auto-sitemap'
 196
 197     Whether to publish a site-map during
 198     `org-publish-current-project' or `org-publish-all'.
 199
 200   `:sitemap-filename'
 201
 202     Filename for output of sitemap.  Defaults to \"sitemap.org\".
 203
 204   `:sitemap-title'
 205
 206     Title of site-map page.  Defaults to name of file.
 207
 208   `:sitemap-function'
 209
 210     Plugin function to use for generation of site-map.  Defaults
 211     to `org-publish-org-sitemap', which generates a plain list of
 212     links to all files in the project.
 213
 214   `:sitemap-style'
 215
 216     Can be `list' (site-map is just an itemized list of the
 217     titles of the files involved) or `tree' (the directory
 218     structure of the source files is reflected in the site-map).
 219     Defaults to `tree'.
 220
 221   `:sitemap-sans-extension'
 222
 223     Remove extension from site-map's file-names.  Useful to have
 224     cool URIs (see http://www.w3.org/Provider/Style/URI).
 225     Defaults to nil.
 226
 227 If you create a site-map file, adjust the sorting like this:
 228
 229   `:sitemap-sort-folders'
 230
 231     Where folders should appear in the site-map.  Set this to
 232     `first' (default) or `last' to display folders first or last,
 233     respectively.  Any other value will mix files and folders.
 234
 235   `:sitemap-sort-files'
 236
 237     The site map is normally sorted alphabetically.  You can
 238     change this behaviour setting this to `anti-chronologically',
 239     `chronologically', or nil.
 240
 241   `:sitemap-ignore-case'
 242
 243     Should sorting be case-sensitive?  Default nil.
 244
 245 The following property control the creation of a concept index.
 246
 247   `:makeindex'
 248
 249     Create a concept index.  The file containing the index has to
 250     be called \"theindex.org\".  If it doesn't exist in the
 251     project, it will be generated.  Contents of the index are
 252     stored in the file \"theindex.inc\", which can be included in
 253     \"theindex.org\".
 254
 255 Other properties affecting publication.
 256
 257   `:body-only'
 258
 259     Set this to t to publish only the body of the documents."
 260   :group 'org-export-publish
 261   :type 'alist)
 262
 263 (defcustom org-publish-use-timestamps-flag t
 264   "Non-nil means use timestamp checking to publish only changed files.
 265 When nil, do no timestamp checking and always publish all files."
 266   :group 'org-export-publish
 267   :type 'boolean)
 268
 269 (defcustom org-publish-timestamp-directory
 270   (convert-standard-filename "~/.org-timestamps/")
 271   "Name of directory in which to store publishing timestamps."
 272   :group 'org-export-publish
 273   :type 'directory)
 274
 275 (defcustom org-publish-list-skipped-files t
 276   "Non-nil means show message about files *not* published."
 277   :group 'org-export-publish
 278   :type 'boolean)
 279
 280 (defcustom org-publish-sitemap-sort-files 'alphabetically
 281   "Method to sort files in site-maps.
 282 Possible values are `alphabetically', `chronologically',
 283 `anti-chronologically' and nil.
 284
 285 If `alphabetically', files will be sorted alphabetically.  If
 286 `chronologically', files will be sorted with older modification
 287 time first.  If `anti-chronologically', files will be sorted with
 288 newer modification time first.  nil won't sort files.
 289
 290 You can overwrite this default per project in your
 291 `org-publish-project-alist', using `:sitemap-sort-files'."
 292   :group 'org-export-publish
 293   :type 'symbol)
 294
 295 (defcustom org-publish-sitemap-sort-folders 'first
 296   "A symbol, denoting if folders are sorted first in sitemaps.
 297 Possible values are `first', `last', and nil.
 298 If `first', folders will be sorted before files.
 299 If `last', folders are sorted to the end after the files.
 300 Any other value will not mix files and folders.
 301
 302 You can overwrite this default per project in your
 303 `org-publish-project-alist', using `:sitemap-sort-folders'."
 304   :group 'org-export-publish
 305   :type 'symbol)
 306
 307 (defcustom org-publish-sitemap-sort-ignore-case nil
 308   "Non-nil when site-map sorting should ignore case.
 309
 310 You can overwrite this default per project in your
 311 `org-publish-project-alist', using `:sitemap-ignore-case'."
 312   :group 'org-export-publish
 313   :type 'boolean)
 314
 315 (defcustom org-publish-sitemap-date-format "%Y-%m-%d"
 316   "Format for printing a date in the sitemap.
 317 See `format-time-string' for allowed formatters."
 318   :group 'org-export-publish
 319   :type 'string)
 320
 321 (defcustom org-publish-sitemap-file-entry-format "%t"
 322   "Format string for site-map file entry.
 323 You could use brackets to delimit on what part the link will be.
 324
 325 %t is the title.
 326 %a is the author.
 327 %d is the date formatted using `org-publish-sitemap-date-format'."
 328   :group 'org-export-publish
 329   :type 'string)
 330
 331
 332 \f
 333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 334 ;;; Timestamp-related functions
 335
 336 (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
 337   "Return path to timestamp file for filename FILENAME."
 338   (setq filename (concat filename "::" (or pub-dir "") "::"
 339                          (format "%s" (or pub-func ""))))
 340   (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
 341
 342 (defun org-publish-needed-p
 343   (filename &optional pub-dir pub-func true-pub-dir base-dir)
 344   "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
 345 TRUE-PUB-DIR is where the file will truly end up.  Currently we
 346 are not using this - maybe it can eventually be used to check if
 347 the file is present at the target location, and how old it is.
 348 Right now we cannot do this, because we do not know under what
 349 file name the file will be stored - the publishing function can
 350 still decide about that independently."
 351   (let ((rtn (if (not org-publish-use-timestamps-flag) t
 352                (org-publish-cache-file-needs-publishing
 353                 filename pub-dir pub-func base-dir))))
 354     (if rtn (message "Publishing file %s using `%s'" filename pub-func)
 355       (when org-publish-list-skipped-files
 356         (message   "Skipping unmodified file %s" filename)))
 357     rtn))
 358
 359 (defun org-publish-update-timestamp
 360   (filename &optional pub-dir pub-func base-dir)
 361   "Update publishing timestamp for file FILENAME.
 362 If there is no timestamp, create one."
 363   (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
 364         (stamp (org-publish-cache-ctime-of-src filename)))
 365     (org-publish-cache-set key stamp)))
 366
 367 (defun org-publish-remove-all-timestamps ()
 368   "Remove all files in the timestamp directory."
 369   (let ((dir org-publish-timestamp-directory)
 370         files)
 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         (case 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           ((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) (<= A B)
 425                      (>= A B)))))))
 426       ;; Directory-wise wins:
 427       (when org-publish-sitemap-sort-folders
 428         ;; a is directory, b not:
 429         (cond
 430          ((and (file-directory-p a) (not (file-directory-p b)))
 431           (setq retval (equal org-publish-sitemap-sort-folders 'first)))
 432          ;; a is not a directory, but b is:
 433          ((and (not (file-directory-p a)) (file-directory-p b))
 434           (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
 435     retval))
 436
 437 (defun org-publish-get-base-files-1
 438   (base-dir &optional recurse match skip-file skip-dir)
 439   "Set `org-publish-temp-files' with files from BASE-DIR directory.
 440 If RECURSE is non-nil, check BASE-DIR recursively.  If MATCH is
 441 non-nil, restrict this list to the files matching the regexp
 442 MATCH.  If SKIP-FILE is non-nil, skip file matching the regexp
 443 SKIP-FILE.  If SKIP-DIR is non-nil, don't check directories
 444 matching the regexp SKIP-DIR when recursing through BASE-DIR."
 445   (mapc (lambda (f)
 446           (let ((fd-p (file-directory-p f))
 447                 (fnd (file-name-nondirectory f)))
 448             (if (and fd-p recurse
 449                      (not (string-match "^\\.+$" fnd))
 450                      (if skip-dir (not (string-match skip-dir fnd)) t))
 451                 (org-publish-get-base-files-1
 452                  f recurse match skip-file skip-dir)
 453               (unless (or fd-p ;; this is a directory
 454                           (and skip-file (string-match skip-file fnd))
 455                           (not (file-exists-p (file-truename f)))
 456                           (not (string-match match fnd)))
 457
 458                 (pushnew f org-publish-temp-files)))))
 459         (let ((all-files (if (not recurse) (directory-files base-dir t match)
 460                            ;; If RECURSE is non-nil, we want all files
 461                            ;; matching MATCH and sub-directories.
 462                            (org-remove-if-not
 463                             (lambda (file)
 464                               (or (file-directory-p file)
 465                                   (and match (string-match match file))))
 466                             (directory-files base-dir t)))))
 467           (if (not org-publish-sitemap-requested) all-files
 468             (sort all-files 'org-publish-compare-directory-files)))))
 469
 470 (defun org-publish-get-base-files (project &optional exclude-regexp)
 471   "Return a list of all files in PROJECT.
 472 If EXCLUDE-REGEXP is set, this will be used to filter out
 473 matching filenames."
 474   (let* ((project-plist (cdr project))
 475          (base-dir (file-name-as-directory
 476                     (plist-get project-plist :base-directory)))
 477          (include-list (plist-get project-plist :include))
 478          (recurse (plist-get project-plist :recursive))
 479          (extension (or (plist-get project-plist :base-extension) "org"))
 480          ;; sitemap-... variables are dynamically scoped for
 481          ;; org-publish-compare-directory-files:
 482          (org-publish-sitemap-requested
 483           (plist-get project-plist :auto-sitemap))
 484          (sitemap-filename
 485           (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
 486          (org-publish-sitemap-sort-folders
 487           (if (plist-member project-plist :sitemap-sort-folders)
 488               (plist-get project-plist :sitemap-sort-folders)
 489             org-publish-sitemap-sort-folders))
 490          (org-publish-sitemap-sort-files
 491           (cond ((plist-member project-plist :sitemap-sort-files)
 492                  (plist-get project-plist :sitemap-sort-files))
 493                 ;; For backward compatibility:
 494                 ((plist-member project-plist :sitemap-alphabetically)
 495                  (if (plist-get project-plist :sitemap-alphabetically)
 496                      'alphabetically nil))
 497                 (t org-publish-sitemap-sort-files)))
 498          (org-publish-sitemap-ignore-case
 499           (if (plist-member project-plist :sitemap-ignore-case)
 500               (plist-get project-plist :sitemap-ignore-case)
 501             org-publish-sitemap-sort-ignore-case))
 502          (match (if (eq extension 'any) "^[^\\.]"
 503                   (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
 504     ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
 505     ;; value.
 506     (unless (memq org-publish-sitemap-sort-folders '(first last))
 507       (setq org-publish-sitemap-sort-folders nil))
 508
 509     (setq org-publish-temp-files nil)
 510     (if org-publish-sitemap-requested
 511         (pushnew (expand-file-name (concat base-dir sitemap-filename))
 512                   org-publish-temp-files))
 513     (org-publish-get-base-files-1 base-dir recurse match
 514                                   ;; FIXME distinguish exclude regexp
 515                                   ;; for skip-file and skip-dir?
 516                                   exclude-regexp exclude-regexp)
 517     (mapc (lambda (f)
 518             (pushnew
 519              (expand-file-name (concat base-dir f))
 520              org-publish-temp-files))
 521           include-list)
 522     org-publish-temp-files))
 523
 524 (defun org-publish-get-project-from-filename (filename &optional up)
 525   "Return the project that FILENAME belongs to."
 526   (let* ((filename (expand-file-name filename))
 527          project-name)
 528
 529     (catch 'p-found
 530       (dolist (prj org-publish-project-alist)
 531         (unless (plist-get (cdr prj) :components)
 532           ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
 533           (let* ((r (plist-get (cdr prj) :recursive))
 534                  (b (expand-file-name (file-name-as-directory
 535                                        (plist-get (cdr prj) :base-directory))))
 536                  (x (or (plist-get (cdr prj) :base-extension) "org"))
 537                  (e (plist-get (cdr prj) :exclude))
 538                  (i (plist-get (cdr prj) :include))
 539                  (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
 540             (when
 541                 (or (and i
 542                          (member filename
 543                                  (mapcar (lambda (file)
 544                                            (expand-file-name file b))
 545                                          i)))
 546                     (and (not (and e (string-match e filename)))
 547                          (string-match xm filename)))
 548               (setq project-name (car prj))
 549               (throw 'p-found project-name))))))
 550     (when up
 551       (dolist (prj org-publish-project-alist)
 552         (if (member project-name (plist-get (cdr prj) :components))
 553             (setq project-name (car prj)))))
 554     (assoc project-name org-publish-project-alist)))
 555
 556
 557 \f
 558 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 559 ;;; Tools for publishing functions in back-ends
 560
 561 (defun org-publish-org-to (backend filename extension plist &optional pub-dir)
 562   "Publish an Org file to a specified back-end.
 563
 564 BACKEND is a symbol representing the back-end used for
 565 transcoding.  FILENAME is the filename of the Org file to be
 566 published.  EXTENSION is the extension used for the output
 567 string, with the leading dot.  PLIST is the property list for the
 568 given project.
 569
 570 Optional argument PUB-DIR, when non-nil is the publishing
 571 directory.
 572
 573 Return output file name."
 574   (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
 575   ;; Check if a buffer visiting FILENAME is already open.
 576   (let* ((org-inhibit-startup t)
 577          (visitingp (find-buffer-visiting filename))
 578          (work-buffer (or visitingp (find-file-noselect filename))))
 579     (prog1 (with-current-buffer work-buffer
 580              (let ((output-file
 581                     (org-export-output-file-name extension nil pub-dir))
 582                    (body-p (plist-get plist :body-only)))
 583                (org-export-to-file backend output-file
 584                  nil nil nil body-p
 585                  ;; Add `org-publish-collect-numbering' and
 586                  ;; `org-publish-collect-index' to final output
 587                  ;; filters.  The latter isn't dependent on
 588                  ;; `:makeindex', since we want to keep it up-to-date
 589                  ;; in cache anyway.
 590                  (org-combine-plists
 591                   plist
 592                   `(:filter-final-output
 593                     ,(cons 'org-publish-collect-numbering
 594                            (cons 'org-publish-collect-index
 595                                  (plist-get plist :filter-final-output))))))))
 596       ;; Remove opened buffer in the process.
 597       (unless visitingp (kill-buffer work-buffer)))))
 598
 599 (defun org-publish-attachment (plist filename pub-dir)
 600   "Publish a file with no transformation of any kind.
 601
 602 FILENAME is the filename of the Org file to be published.  PLIST
 603 is the property list for the given project.  PUB-DIR is the
 604 publishing directory.
 605
 606 Return output file name."
 607   (unless (file-directory-p pub-dir)
 608     (make-directory pub-dir t))
 609   (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
 610     (or (equal (expand-file-name (file-name-directory filename))
 611                (file-name-as-directory (expand-file-name pub-dir)))
 612         (copy-file filename output t))
 613     ;; Return file name.
 614     output))
 615
 616
 617 \f
 618 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 619 ;;; Publishing files, sets of files, and indices
 620
 621 (defun org-publish-file (filename &optional project no-cache)
 622   "Publish file FILENAME from PROJECT.
 623 If NO-CACHE is not nil, do not initialize org-publish-cache and
 624 write it to disk.  This is needed, since this function is used to
 625 publish single files, when entire projects are published.
 626 See `org-publish-projects'."
 627   (let* ((project
 628           (or project
 629               (or (org-publish-get-project-from-filename filename)
 630                   (error "File %s not part of any known project"
 631                          (abbreviate-file-name filename)))))
 632          (project-plist (cdr project))
 633          (ftname (expand-file-name filename))
 634          (publishing-function
 635           (let ((fun (plist-get project-plist :publishing-function)))
 636             (cond ((null fun) (error "No publishing function chosen"))
 637                   ((listp fun) fun)
 638                   (t (list fun)))))
 639          (base-dir
 640           (file-name-as-directory
 641            (expand-file-name
 642             (or (plist-get project-plist :base-directory)
 643                 (error "Project %s does not have :base-directory defined"
 644                        (car project))))))
 645          (pub-dir
 646           (file-name-as-directory
 647            (file-truename
 648             (or (eval (plist-get project-plist :publishing-directory))
 649                 (error "Project %s does not have :publishing-directory defined"
 650                        (car project))))))
 651          tmp-pub-dir)
 652
 653     (unless no-cache (org-publish-initialize-cache (car project)))
 654
 655     (setq tmp-pub-dir
 656           (file-name-directory
 657            (concat pub-dir
 658                    (and (string-match (regexp-quote base-dir) ftname)
 659                         (substring ftname (match-end 0))))))
 660     ;; Allow chain of publishing functions.
 661     (dolist (f publishing-function)
 662       (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
 663         (let ((output (funcall f project-plist filename tmp-pub-dir)))
 664           (org-publish-update-timestamp filename pub-dir f base-dir)
 665           (run-hook-with-args 'org-publish-after-publishing-hook
 666                               filename
 667                               output))))
 668     (unless no-cache (org-publish-write-cache-file))))
 669
 670 (defun org-publish-projects (projects)
 671   "Publish all files belonging to the PROJECTS alist.
 672 If `:auto-sitemap' is set, publish the sitemap too.  If
 673 `:makeindex' is set, also produce a file theindex.org."
 674   (mapc
 675    (lambda (project)
 676      ;; Each project uses its own cache file:
 677      (org-publish-initialize-cache (car project))
 678      (let* ((project-plist (cdr project))
 679             (exclude-regexp (plist-get project-plist :exclude))
 680             (sitemap-p (plist-get project-plist :auto-sitemap))
 681             (sitemap-filename (or (plist-get project-plist :sitemap-filename)
 682                                   "sitemap.org"))
 683             (sitemap-function (or (plist-get project-plist :sitemap-function)
 684                                   'org-publish-org-sitemap))
 685             (org-publish-sitemap-date-format
 686              (or (plist-get project-plist :sitemap-date-format)
 687                  org-publish-sitemap-date-format))
 688             (org-publish-sitemap-file-entry-format
 689              (or (plist-get project-plist :sitemap-file-entry-format)
 690                  org-publish-sitemap-file-entry-format))
 691             (preparation-function
 692              (plist-get project-plist :preparation-function))
 693             (completion-function (plist-get project-plist :completion-function))
 694             (files (org-publish-get-base-files project exclude-regexp))
 695             (theindex
 696              (expand-file-name "theindex.org"
 697                                (plist-get project-plist :base-directory))))
 698        (when preparation-function (run-hooks 'preparation-function))
 699        (if sitemap-p (funcall sitemap-function project sitemap-filename))
 700        ;; Publish all files from PROJECT excepted "theindex.org".  Its
 701        ;; publishing will be deferred until "theindex.inc" is
 702        ;; populated.
 703        (dolist (file files)
 704          (unless (equal file theindex)
 705            (org-publish-file file project t)))
 706        ;; Populate "theindex.inc", if needed, and publish
 707        ;; "theindex.org".
 708        (when (plist-get project-plist :makeindex)
 709          (org-publish-index-generate-theindex
 710           project (plist-get project-plist :base-directory))
 711          (org-publish-file theindex project t))
 712        (when completion-function (run-hooks 'completion-function))
 713        (org-publish-write-cache-file)))
 714    (org-publish-expand-projects projects)))
 715
 716 (defun org-publish-org-sitemap (project &optional sitemap-filename)
 717   "Create a sitemap of pages in set defined by PROJECT.
 718 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 719 Default for SITEMAP-FILENAME is 'sitemap.org'."
 720   (let* ((project-plist (cdr project))
 721          (dir (file-name-as-directory
 722                (plist-get project-plist :base-directory)))
 723          (localdir (file-name-directory dir))
 724          (indent-str (make-string 2 ?\ ))
 725          (exclude-regexp (plist-get project-plist :exclude))
 726          (files (nreverse
 727                  (org-publish-get-base-files project exclude-regexp)))
 728          (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
 729          (sitemap-title (or (plist-get project-plist :sitemap-title)
 730                           (concat "Sitemap for project " (car project))))
 731          (sitemap-style (or (plist-get project-plist :sitemap-style)
 732                             'tree))
 733          (sitemap-sans-extension
 734           (plist-get project-plist :sitemap-sans-extension))
 735          (visiting (find-buffer-visiting sitemap-filename))
 736          (ifn (file-name-nondirectory sitemap-filename))
 737          file sitemap-buffer)
 738     (with-current-buffer
 739         (let ((org-inhibit-startup t))
 740           (setq sitemap-buffer
 741                 (or visiting (find-file sitemap-filename))))
 742       (erase-buffer)
 743       (insert (concat "#+TITLE: " sitemap-title "\n\n"))
 744       (while (setq file (pop files))
 745         (let ((fn (file-name-nondirectory file))
 746               (link (file-relative-name file dir))
 747               (oldlocal localdir))
 748           (when sitemap-sans-extension
 749             (setq link (file-name-sans-extension link)))
 750           ;; sitemap shouldn't list itself
 751           (unless (equal (file-truename sitemap-filename)
 752                          (file-truename file))
 753             (if (eq sitemap-style 'list)
 754                 (message "Generating list-style sitemap for %s" sitemap-title)
 755               (message "Generating tree-style sitemap for %s" sitemap-title)
 756               (setq localdir (concat (file-name-as-directory dir)
 757                                      (file-name-directory link)))
 758               (unless (string= localdir oldlocal)
 759                 (if (string= localdir dir)
 760                     (setq indent-str (make-string 2 ?\ ))
 761                   (let ((subdirs
 762                          (split-string
 763                           (directory-file-name
 764                            (file-name-directory
 765                             (file-relative-name localdir dir))) "/"))
 766                         (subdir "")
 767                         (old-subdirs (split-string
 768                                       (file-relative-name oldlocal dir) "/")))
 769                     (setq indent-str (make-string 2 ?\ ))
 770                     (while (string= (car old-subdirs) (car subdirs))
 771                       (setq indent-str (concat indent-str (make-string 2 ?\ )))
 772                       (pop old-subdirs)
 773                       (pop subdirs))
 774                     (dolist (d subdirs)
 775                       (setq subdir (concat subdir d "/"))
 776                       (insert (concat indent-str " + " d "\n"))
 777                       (setq indent-str (make-string
 778                                         (+ (length indent-str) 2) ?\ )))))))
 779             ;; This is common to 'flat and 'tree
 780             (let ((entry
 781                    (org-publish-format-file-entry
 782                     org-publish-sitemap-file-entry-format file project-plist))
 783                   (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
 784               (cond ((string-match-p regexp entry)
 785                      (string-match regexp entry)
 786                      (insert (concat indent-str " + " (match-string 1 entry)
 787                                      "[[file:" link "]["
 788                                      (match-string 2 entry)
 789                                      "]]" (match-string 3 entry) "\n")))
 790                     (t
 791                      (insert (concat indent-str " + [[file:" link "]["
 792                                      entry
 793                                      "]]\n"))))))))
 794       (save-buffer))
 795     (or visiting (kill-buffer sitemap-buffer))))
 796
 797 (defun org-publish-format-file-entry (fmt file project-plist)
 798   (format-spec
 799    fmt
 800    `((?t . ,(org-publish-find-title file t))
 801      (?d . ,(format-time-string org-publish-sitemap-date-format
 802                                 (org-publish-find-date file)))
 803      (?a . ,(or (plist-get project-plist :author) user-full-name)))))
 804
 805 (defun org-publish-find-title (file &optional reset)
 806   "Find the title of FILE in project."
 807   (or
 808    (and (not reset) (org-publish-cache-get-file-property file :title nil t))
 809    (let* ((org-inhibit-startup t)
 810           (visiting (find-buffer-visiting file))
 811           (buffer (or visiting (find-file-noselect file))))
 812      (with-current-buffer buffer
 813        (let ((title
 814               (let ((property
 815                      (plist-get
 816                       ;; protect local variables in open buffers
 817                       (if visiting
 818                           (org-export-with-buffer-copy (org-export-get-environment))
 819                         (org-export-get-environment))
 820                       :title)))
 821                 (if property
 822                     (org-no-properties (org-element-interpret-data property))
 823                   (file-name-nondirectory (file-name-sans-extension file))))))
 824          (unless visiting (kill-buffer buffer))
 825          (org-publish-cache-set-file-property file :title title)
 826          title)))))
 827
 828 (defun org-publish-find-date (file)
 829   "Find the date of FILE in project.
 830 This function assumes FILE is either a directory or an Org file.
 831 If FILE is an Org file and provides a DATE keyword use it.  In
 832 any other case use the file system's modification time.  Return
 833 time in `current-time' format."
 834   (if (file-directory-p file) (nth 5 (file-attributes file))
 835     (let* ((org-inhibit-startup t)
 836            (visiting (find-buffer-visiting file))
 837            (file-buf (or visiting (find-file-noselect file nil)))
 838            (date (plist-get
 839                   (with-current-buffer file-buf
 840                     (if visiting
 841                         (org-export-with-buffer-copy (org-export-get-environment))
 842                       (org-export-get-environment)))
 843                   :date)))
 844       (unless visiting (kill-buffer file-buf))
 845       ;; DATE is either a timestamp object or a secondary string.  If it
 846       ;; is a timestamp or if the secondary string contains a timestamp,
 847       ;; convert it to internal format.  Otherwise, use FILE
 848       ;; modification time.
 849       (cond ((eq (org-element-type date) 'timestamp)
 850              (org-time-string-to-time (org-element-interpret-data date)))
 851             ((let ((ts (and (consp date) (assq 'timestamp date))))
 852                (and ts
 853                     (let ((value (org-element-interpret-data ts)))
 854                       (and (org-string-nw-p value)
 855                            (org-time-string-to-time value))))))
 856             ((file-exists-p file) (nth 5 (file-attributes file)))
 857             (t (error "No such file: \"%s\"" file))))))
 858
 859
 860 \f
 861 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 862 ;;; Interactive publishing functions
 863
 864 ;;;###autoload
 865 (defalias 'org-publish-project 'org-publish)
 866
 867 ;;;###autoload
 868 (defun org-publish (project &optional force async)
 869   "Publish PROJECT.
 870
 871 PROJECT is either a project name, as a string, or a project
 872 alist (see `org-publish-project-alist' variable).
 873
 874 When optional argument FORCE is non-nil, force publishing all
 875 files in PROJECT.  With a non-nil optional argument ASYNC,
 876 publishing will be done asynchronously, in another process."
 877   (interactive
 878    (list
 879     (assoc (org-icompleting-read
 880             "Publish project: "
 881             org-publish-project-alist nil t)
 882            org-publish-project-alist)
 883     current-prefix-arg))
 884   (let ((project-alist  (if (not (stringp project)) (list project)
 885                           ;; If this function is called in batch mode,
 886                           ;; project is still a string here.
 887                           (list (assoc project org-publish-project-alist)))))
 888     (if async
 889         (org-export-async-start 'ignore
 890           `(let ((org-publish-use-timestamps-flag
 891                   (if ',force nil ,org-publish-use-timestamps-flag)))
 892              (org-publish-projects ',project-alist)))
 893       (save-window-excursion
 894         (let* ((org-publish-use-timestamps-flag
 895                 (if force nil org-publish-use-timestamps-flag)))
 896           (org-publish-projects project-alist))))))
 897
 898 ;;;###autoload
 899 (defun org-publish-all (&optional force async)
 900   "Publish all projects.
 901 With prefix argument FORCE, remove all files in the timestamp
 902 directory and force publishing all projects.  With a non-nil
 903 optional argument ASYNC, publishing will be done asynchronously,
 904 in another process."
 905   (interactive "P")
 906   (if async
 907       (org-export-async-start 'ignore
 908         `(progn
 909            (when ',force (org-publish-remove-all-timestamps))
 910            (let ((org-publish-use-timestamps-flag
 911                   (if ',force nil ,org-publish-use-timestamps-flag)))
 912              (org-publish-projects ',org-publish-project-alist))))
 913     (when force (org-publish-remove-all-timestamps))
 914     (save-window-excursion
 915       (let ((org-publish-use-timestamps-flag
 916              (if force nil org-publish-use-timestamps-flag)))
 917         (org-publish-projects org-publish-project-alist)))))
 918
 919
 920 ;;;###autoload
 921 (defun org-publish-current-file (&optional force async)
 922   "Publish the current file.
 923 With prefix argument FORCE, force publish the file.  When
 924 optional argument ASYNC is non-nil, publishing will be done
 925 asynchronously, in another process."
 926   (interactive "P")
 927   (let ((file (buffer-file-name (buffer-base-buffer))))
 928     (if async
 929         (org-export-async-start 'ignore
 930           `(let ((org-publish-use-timestamps-flag
 931                   (if ',force nil ,org-publish-use-timestamps-flag)))
 932              (org-publish-file ,file)))
 933       (save-window-excursion
 934         (let ((org-publish-use-timestamps-flag
 935                (if force nil org-publish-use-timestamps-flag)))
 936           (org-publish-file file))))))
 937
 938 ;;;###autoload
 939 (defun org-publish-current-project (&optional force async)
 940   "Publish the project associated with the current file.
 941 With a prefix argument, force publishing of all files in
 942 the project."
 943   (interactive "P")
 944   (save-window-excursion
 945     (let ((project (org-publish-get-project-from-filename
 946                     (buffer-file-name (buffer-base-buffer)) 'up)))
 947       (if project (org-publish project force async)
 948         (error "File %s is not part of any known project"
 949                (buffer-file-name (buffer-base-buffer)))))))
 950
 951
 952 \f
 953 ;;; Index generation
 954
 955 (defun org-publish-collect-index (output backend info)
 956   "Update index for a file in cache.
 957
 958 OUTPUT is the output from transcoding current file.  BACKEND is
 959 the back-end that was used for transcoding.  INFO is a plist
 960 containing publishing and export options.
 961
 962 The index relative to current file is stored as an alist.  An
 963 association has the following shape: (TERM FILE-NAME PARENT),
 964 where TERM is the indexed term, as a string, FILE-NAME is the
 965 original full path of the file where the term in encountered, and
 966 PARENT is a reference to the headline, if any, containing the
 967 original index keyword.  When non-nil, this reference is a cons
 968 cell.  Its CAR is a symbol among `id', `custom-id' and `name' and
 969 its CDR is a string."
 970   (let ((file (plist-get info :input-file)))
 971     (org-publish-cache-set-file-property
 972      file :index
 973      (delete-dups
 974       (org-element-map (plist-get info :parse-tree) 'keyword
 975         (lambda (k)
 976           (when (equal (org-element-property :key k) "INDEX")
 977             (let ((parent (org-export-get-parent-headline k)))
 978               (list (org-element-property :value k)
 979                     file
 980                     (cond
 981                      ((not parent) nil)
 982                      ((let ((id (org-element-property :ID parent)))
 983                         (and id (cons 'id id))))
 984                      ((let ((id (org-element-property :CUSTOM_ID parent)))
 985                         (and id (cons 'custom-id id))))
 986                      (t (cons 'name
 987                               ;; Remove statistics cookie.
 988                               (replace-regexp-in-string
 989                                "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
 990                                (org-element-property :raw-value parent)))))))))
 991         info))))
 992   ;; Return output unchanged.
 993   output)
 994
 995 (defun org-publish-index-generate-theindex (project directory)
 996   "Retrieve full index from cache and build \"theindex.org\".
 997 PROJECT is the project the index relates to.  DIRECTORY is the
 998 publishing directory."
 999   (let ((all-files (org-publish-get-base-files
1000                     project (plist-get (cdr project) :exclude)))
1001         full-index)
1002     ;; Compile full index and sort it alphabetically.
1003     (dolist (file all-files
1004                   (setq full-index
1005                         (sort (nreverse full-index)
1006                               (lambda (a b) (string< (downcase (car a))
1007                                                 (downcase (car b)))))))
1008       (let ((index (org-publish-cache-get-file-property file :index)))
1009         (dolist (term index)
1010           (unless (member term full-index) (push term full-index)))))
1011     ;; Write "theindex.inc" in DIRECTORY.
1012     (with-temp-file (expand-file-name "theindex.inc" directory)
1013       (let ((current-letter nil) (last-entry nil))
1014         (dolist (idx full-index)
1015           (let* ((entry (org-split-string (car idx) "!"))
1016                  (letter (upcase (substring (car entry) 0 1)))
1017                  ;; Transform file into a path relative to publishing
1018                  ;; directory.
1019                  (file (file-relative-name
1020                         (nth 1 idx)
1021                         (plist-get (cdr project) :base-directory))))
1022             ;; Check if another letter has to be inserted.
1023             (unless (string= letter current-letter)
1024               (insert (format "* %s\n" letter)))
1025             ;; Compute the first difference between last entry and
1026             ;; current one: it tells the level at which new items
1027             ;; should be added.
1028             (let* ((rank (if (equal entry last-entry) (1- (length entry))
1029                            (loop for n from 0 to (length entry)
1030                                  unless (equal (nth n entry) (nth n last-entry))
1031                                  return n)))
1032                    (len (length (nthcdr rank entry))))
1033               ;; For each term after the first difference, create
1034               ;; a new sub-list with the term as body.  Moreover,
1035               ;; linkify the last term.
1036               (dotimes (n len)
1037                 (insert
1038                  (concat
1039                   (make-string (* (+ rank n) 2) ? ) "  - "
1040                   (if (not (= (1- len) n)) (nth (+ rank n) entry)
1041                     ;; Last term: Link it to TARGET, if possible.
1042                     (let ((target (nth 2 idx)))
1043                       (format
1044                        "[[%s][%s]]"
1045                        ;; Destination.
1046                        (case (car target)
1047                          ('nil (format "file:%s" file))
1048                          (id (format "id:%s" (cdr target)))
1049                          (custom-id (format "file:%s::#%s" file (cdr target)))
1050                          (otherwise (format "file:%s::*%s" file (cdr target))))
1051                        ;; Description.
1052                        (car (last entry)))))
1053                   "\n"))))
1054             (setq current-letter letter last-entry entry))))
1055       ;; Create "theindex.org", if it doesn't exist yet, and provide
1056       ;; a default index file.
1057       (let ((index.org (expand-file-name "theindex.org" directory)))
1058         (unless (file-exists-p index.org)
1059           (with-temp-file index.org
1060             (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
1061
1062
1063 \f
1064 ;;; External Fuzzy Links Resolution
1065 ;;
1066 ;; This part implements tools to resolve [[file.org::*Some headline]]
1067 ;; links, where "file.org" belongs to the current project.
1068
1069 (defun org-publish-collect-numbering (output backend info)
1070   (org-publish-cache-set-file-property
1071    (plist-get info :input-file) :numbering
1072    (mapcar (lambda (entry)
1073              (cons (org-split-string
1074                     (replace-regexp-in-string
1075                      "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
1076                      (org-element-property :raw-value (car entry))))
1077                    (cdr entry)))
1078            (plist-get info :headline-numbering)))
1079   ;; Return output unchanged.
1080   output)
1081
1082 (defun org-publish-resolve-external-fuzzy-link (file fuzzy)
1083   "Return numbering for headline matching FUZZY search in FILE.
1084
1085 Return value is a list of numbers, or nil.  This function allows
1086 to resolve external fuzzy links like:
1087
1088   [[file.org::*fuzzy][description]]"
1089   (when org-publish-cache
1090     (cdr (assoc (org-split-string
1091                  (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
1092                 (org-publish-cache-get-file-property
1093                  (expand-file-name file) :numbering nil t)))))
1094
1095
1096 \f
1097 ;;; Caching functions
1098
1099 (defun org-publish-write-cache-file (&optional free-cache)
1100   "Write `org-publish-cache' to file.
1101 If FREE-CACHE, empty the cache."
1102   (unless org-publish-cache
1103     (error "`org-publish-write-cache-file' called, but no cache present"))
1104
1105   (let ((cache-file (org-publish-cache-get ":cache-file:")))
1106     (unless cache-file
1107       (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
1108     (with-temp-file cache-file
1109       (let (print-level print-length)
1110         (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
1111         (maphash (lambda (k v)
1112                    (insert
1113                     (format (concat "(puthash %S "
1114                                     (if (or (listp v) (symbolp v))
1115                                         "'" "")
1116                                     "%S org-publish-cache)\n") k v)))
1117                  org-publish-cache)))
1118     (when free-cache (org-publish-reset-cache))))
1119
1120 (defun org-publish-initialize-cache (project-name)
1121   "Initialize the projects cache if not initialized yet and return it."
1122
1123   (unless project-name
1124     (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
1125
1126   (unless (file-exists-p org-publish-timestamp-directory)
1127     (make-directory org-publish-timestamp-directory t))
1128   (unless (file-directory-p org-publish-timestamp-directory)
1129     (error "Org publish timestamp: %s is not a directory"
1130            org-publish-timestamp-directory))
1131
1132   (unless (and org-publish-cache
1133                (string= (org-publish-cache-get ":project:") project-name))
1134     (let* ((cache-file
1135             (concat
1136              (expand-file-name org-publish-timestamp-directory)
1137              project-name ".cache"))
1138            (cexists (file-exists-p cache-file)))
1139
1140       (when org-publish-cache (org-publish-reset-cache))
1141
1142       (if cexists (load-file cache-file)
1143         (setq org-publish-cache
1144               (make-hash-table :test 'equal :weakness nil :size 100))
1145         (org-publish-cache-set ":project:" project-name)
1146         (org-publish-cache-set ":cache-file:" cache-file))
1147       (unless cexists (org-publish-write-cache-file nil))))
1148   org-publish-cache)
1149
1150 (defun org-publish-reset-cache ()
1151   "Empty org-publish-cache and reset it nil."
1152   (message "%s" "Resetting org-publish-cache")
1153   (when (hash-table-p org-publish-cache)
1154     (clrhash org-publish-cache))
1155   (setq org-publish-cache nil))
1156
1157 (defun org-publish-cache-file-needs-publishing
1158   (filename &optional pub-dir pub-func base-dir)
1159   "Check the timestamp of the last publishing of FILENAME.
1160 Return non-nil if the file needs publishing.  Also check if
1161 any included files have been more recently published, so that
1162 the file including them will be republished as well."
1163   (unless org-publish-cache
1164     (error
1165      "`org-publish-cache-file-needs-publishing' called, but no cache present"))
1166   (let* ((case-fold-search t)
1167          (key (org-publish-timestamp-filename filename pub-dir pub-func))
1168          (pstamp (org-publish-cache-get key))
1169          (org-inhibit-startup t)
1170          (visiting (find-buffer-visiting filename))
1171          included-files-ctime buf)
1172     (when (equal (file-name-extension filename) "org")
1173       (setq buf (find-file (expand-file-name filename)))
1174       (with-current-buffer buf
1175         (goto-char (point-min))
1176         (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
1177           (let* ((element (org-element-at-point))
1178                  (included-file
1179                   (and (eq (org-element-type element) 'keyword)
1180                        (let ((value (org-element-property :value element)))
1181                          (and value
1182                               (string-match "^\\(\".+?\"\\|\\S-+\\)" value)
1183                               (org-remove-double-quotes
1184                                (match-string 1 value)))))))
1185             (when included-file
1186               (add-to-list 'included-files-ctime
1187                            (org-publish-cache-ctime-of-src
1188                             (expand-file-name included-file))
1189                            t)))))
1190       (unless visiting (kill-buffer buf)))
1191     (if (null pstamp) t
1192       (let ((ctime (org-publish-cache-ctime-of-src filename)))
1193         (or (< pstamp ctime)
1194             (when included-files-ctime
1195               (not (null (delq nil (mapcar (lambda (ct) (< ctime ct))
1196                                            included-files-ctime))))))))))
1197
1198 (defun org-publish-cache-set-file-property
1199   (filename property value &optional project-name)
1200   "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
1201 Use cache file of PROJECT-NAME.  If the entry does not exist, it
1202 will be created.  Return VALUE."
1203   ;; Evtl. load the requested cache file:
1204   (if project-name (org-publish-initialize-cache project-name))
1205   (let ((pl (org-publish-cache-get filename)))
1206     (if pl (progn (plist-put pl property value) value)
1207       (org-publish-cache-get-file-property
1208        filename property value nil project-name))))
1209
1210 (defun org-publish-cache-get-file-property
1211   (filename property &optional default no-create project-name)
1212   "Return the value for a PROPERTY of file FILENAME in publishing cache.
1213 Use cache file of PROJECT-NAME. Return the value of that PROPERTY
1214 or DEFAULT, if the value does not yet exist.  If the entry will
1215 be created, unless NO-CREATE is not nil."
1216   ;; Evtl. load the requested cache file:
1217   (if project-name (org-publish-initialize-cache project-name))
1218   (let ((pl (org-publish-cache-get filename)) retval)
1219     (if pl
1220         (if (plist-member pl property)
1221             (setq retval (plist-get pl property))
1222           (setq retval default))
1223       ;; no pl yet:
1224       (unless no-create
1225         (org-publish-cache-set filename (list property default)))
1226       (setq retval default))
1227     retval))
1228
1229 (defun org-publish-cache-get (key)
1230   "Return the value stored in `org-publish-cache' for key KEY.
1231 Returns nil, if no value or nil is found, or the cache does not
1232 exist."
1233   (unless org-publish-cache
1234     (error "`org-publish-cache-get' called, but no cache present"))
1235   (gethash key org-publish-cache))
1236
1237 (defun org-publish-cache-set (key value)
1238   "Store KEY VALUE pair in `org-publish-cache'.
1239 Returns value on success, else nil."
1240   (unless org-publish-cache
1241     (error "`org-publish-cache-set' called, but no cache present"))
1242   (puthash key value org-publish-cache))
1243
1244 (defun org-publish-cache-ctime-of-src (file)
1245   "Get the ctime of FILE as an integer."
1246   (let ((attr (file-attributes
1247                (expand-file-name (or (file-symlink-p file) file)
1248                                  (file-name-directory file)))))
1249     (if (not attr) (error "No such file: \"%s\"" file)
1250       (+ (lsh (car (nth 5 attr)) 16)
1251          (cadr (nth 5 attr))))))
1252
1253
1254 (provide 'ox-publish)
1255
1256 ;; Local variables:
1257 ;; generated-autoload-file: "org-loaddefs.el"
1258 ;; End:
1259
1260 ;;; ox-publish.el ends here