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        (org-mode)
 814        (let ((title
 815               (let ((property (plist-get (org-export-get-environment) :title)))
 816                 (if property
 817                     (org-no-properties (org-element-interpret-data property))
 818                   (file-name-nondirectory (file-name-sans-extension file))))))
 819          (unless visiting (kill-buffer buffer))
 820          (org-publish-cache-set-file-property file :title title)
 821          title)))))
 822
 823 (defun org-publish-find-date (file)
 824   "Find the date of FILE in project.
 825 This function assumes FILE is either a directory or an Org file.
 826 If FILE is an Org file and provides a DATE keyword use it.  In
 827 any other case use the file system's modification time.  Return
 828 time in `current-time' format."
 829   (if (file-directory-p file) (nth 5 (file-attributes file))
 830     (let* ((visiting (find-buffer-visiting file))
 831            (file-buf (or visiting (find-file-noselect file nil)))
 832            (date (plist-get
 833                   (with-current-buffer file-buf
 834                     (let ((org-inhibit-startup t)) (org-mode))
 835                     (org-export-get-environment))
 836                   :date)))
 837       (unless visiting (kill-buffer file-buf))
 838       ;; DATE is either a timestamp object or a secondary string.  If it
 839       ;; is a timestamp or if the secondary string contains a timestamp,
 840       ;; convert it to internal format.  Otherwise, use FILE
 841       ;; modification time.
 842       (cond ((eq (org-element-type date) 'timestamp)
 843              (org-time-string-to-time (org-element-interpret-data date)))
 844             ((let ((ts (and (consp date) (assq 'timestamp date))))
 845                (and ts
 846                     (let ((value (org-element-interpret-data ts)))
 847                       (and (org-string-nw-p value)
 848                            (org-time-string-to-time value))))))
 849             ((file-exists-p file) (nth 5 (file-attributes file)))
 850             (t (error "No such file: \"%s\"" file))))))
 851
 852
 853 \f
 854 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 855 ;;; Interactive publishing functions
 856
 857 ;;;###autoload
 858 (defalias 'org-publish-project 'org-publish)
 859
 860 ;;;###autoload
 861 (defun org-publish (project &optional force async)
 862   "Publish PROJECT.
 863
 864 PROJECT is either a project name, as a string, or a project
 865 alist (see `org-publish-project-alist' variable).
 866
 867 When optional argument FORCE is non-nil, force publishing all
 868 files in PROJECT.  With a non-nil optional argument ASYNC,
 869 publishing will be done asynchronously, in another process."
 870   (interactive
 871    (list
 872     (assoc (org-icompleting-read
 873             "Publish project: "
 874             org-publish-project-alist nil t)
 875            org-publish-project-alist)
 876     current-prefix-arg))
 877   (let ((project-alist  (if (not (stringp project)) (list project)
 878                           ;; If this function is called in batch mode,
 879                           ;; project is still a string here.
 880                           (list (assoc project org-publish-project-alist)))))
 881     (if async
 882         (org-export-async-start 'ignore
 883           `(let ((org-publish-use-timestamps-flag
 884                   (if ',force nil ,org-publish-use-timestamps-flag)))
 885              (org-publish-projects ',project-alist)))
 886       (save-window-excursion
 887         (let* ((org-publish-use-timestamps-flag
 888                 (if force nil org-publish-use-timestamps-flag)))
 889           (org-publish-projects project-alist))))))
 890
 891 ;;;###autoload
 892 (defun org-publish-all (&optional force async)
 893   "Publish all projects.
 894 With prefix argument FORCE, remove all files in the timestamp
 895 directory and force publishing all projects.  With a non-nil
 896 optional argument ASYNC, publishing will be done asynchronously,
 897 in another process."
 898   (interactive "P")
 899   (if async
 900       (org-export-async-start 'ignore
 901         `(progn
 902            (when ',force (org-publish-remove-all-timestamps))
 903            (let ((org-publish-use-timestamps-flag
 904                   (if ',force nil ,org-publish-use-timestamps-flag)))
 905              (org-publish-projects ',org-publish-project-alist))))
 906     (when force (org-publish-remove-all-timestamps))
 907     (save-window-excursion
 908       (let ((org-publish-use-timestamps-flag
 909              (if force nil org-publish-use-timestamps-flag)))
 910         (org-publish-projects org-publish-project-alist)))))
 911
 912
 913 ;;;###autoload
 914 (defun org-publish-current-file (&optional force async)
 915   "Publish the current file.
 916 With prefix argument FORCE, force publish the file.  When
 917 optional argument ASYNC is non-nil, publishing will be done
 918 asynchronously, in another process."
 919   (interactive "P")
 920   (let ((file (buffer-file-name (buffer-base-buffer))))
 921     (if async
 922         (org-export-async-start 'ignore
 923           `(let ((org-publish-use-timestamps-flag
 924                   (if ',force nil ,org-publish-use-timestamps-flag)))
 925              (org-publish-file ,file)))
 926       (save-window-excursion
 927         (let ((org-publish-use-timestamps-flag
 928                (if force nil org-publish-use-timestamps-flag)))
 929           (org-publish-file file))))))
 930
 931 ;;;###autoload
 932 (defun org-publish-current-project (&optional force async)
 933   "Publish the project associated with the current file.
 934 With a prefix argument, force publishing of all files in
 935 the project."
 936   (interactive "P")
 937   (save-window-excursion
 938     (let ((project (org-publish-get-project-from-filename
 939                     (buffer-file-name (buffer-base-buffer)) 'up)))
 940       (if project (org-publish project force async)
 941         (error "File %s is not part of any known project"
 942                (buffer-file-name (buffer-base-buffer)))))))
 943
 944
 945 \f
 946 ;;; Index generation
 947
 948 (defun org-publish-collect-index (output backend info)
 949   "Update index for a file in cache.
 950
 951 OUTPUT is the output from transcoding current file.  BACKEND is
 952 the back-end that was used for transcoding.  INFO is a plist
 953 containing publishing and export options.
 954
 955 The index relative to current file is stored as an alist.  An
 956 association has the following shape: (TERM FILE-NAME PARENT),
 957 where TERM is the indexed term, as a string, FILE-NAME is the
 958 original full path of the file where the term in encountered, and
 959 PARENT is a reference to the headline, if any, containing the
 960 original index keyword.  When non-nil, this reference is a cons
 961 cell.  Its CAR is a symbol among `id', `custom-id' and `name' and
 962 its CDR is a string."
 963   (let ((file (plist-get info :input-file)))
 964     (org-publish-cache-set-file-property
 965      file :index
 966      (delete-dups
 967       (org-element-map (plist-get info :parse-tree) 'keyword
 968         (lambda (k)
 969           (when (equal (org-element-property :key k) "INDEX")
 970             (let ((parent (org-export-get-parent-headline k)))
 971               (list (org-element-property :value k)
 972                     file
 973                     (cond
 974                      ((not parent) nil)
 975                      ((let ((id (org-element-property :ID parent)))
 976                         (and id (cons 'id id))))
 977                      ((let ((id (org-element-property :CUSTOM_ID parent)))
 978                         (and id (cons 'custom-id id))))
 979                      (t (cons 'name
 980                               ;; Remove statistics cookie.
 981                               (replace-regexp-in-string
 982                                "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
 983                                (org-element-property :raw-value parent)))))))))
 984         info))))
 985   ;; Return output unchanged.
 986   output)
 987
 988 (defun org-publish-index-generate-theindex (project directory)
 989   "Retrieve full index from cache and build \"theindex.org\".
 990 PROJECT is the project the index relates to.  DIRECTORY is the
 991 publishing directory."
 992   (let ((all-files (org-publish-get-base-files
 993                     project (plist-get (cdr project) :exclude)))
 994         full-index)
 995     ;; Compile full index and sort it alphabetically.
 996     (dolist (file all-files
 997                   (setq full-index
 998                         (sort (nreverse full-index)
 999                               (lambda (a b) (string< (downcase (car a))
1000                                                 (downcase (car b)))))))
1001       (let ((index (org-publish-cache-get-file-property file :index)))
1002         (dolist (term index)
1003           (unless (member term full-index) (push term full-index)))))
1004     ;; Write "theindex.inc" in DIRECTORY.
1005     (with-temp-file (expand-file-name "theindex.inc" directory)
1006       (let ((current-letter nil) (last-entry nil))
1007         (dolist (idx full-index)
1008           (let* ((entry (org-split-string (car idx) "!"))
1009                  (letter (upcase (substring (car entry) 0 1)))
1010                  ;; Transform file into a path relative to publishing
1011                  ;; directory.
1012                  (file (file-relative-name
1013                         (nth 1 idx)
1014                         (plist-get (cdr project) :base-directory))))
1015             ;; Check if another letter has to be inserted.
1016             (unless (string= letter current-letter)
1017               (insert (format "* %s\n" letter)))
1018             ;; Compute the first difference between last entry and
1019             ;; current one: it tells the level at which new items
1020             ;; should be added.
1021             (let* ((rank (if (equal entry last-entry) (1- (length entry))
1022                            (loop for n from 0 to (length entry)
1023                                  unless (equal (nth n entry) (nth n last-entry))
1024                                  return n)))
1025                    (len (length (nthcdr rank entry))))
1026               ;; For each term after the first difference, create
1027               ;; a new sub-list with the term as body.  Moreover,
1028               ;; linkify the last term.
1029               (dotimes (n len)
1030                 (insert
1031                  (concat
1032                   (make-string (* (+ rank n) 2) ? ) "  - "
1033                   (if (not (= (1- len) n)) (nth (+ rank n) entry)
1034                     ;; Last term: Link it to TARGET, if possible.
1035                     (let ((target (nth 2 idx)))
1036                       (format
1037                        "[[%s][%s]]"
1038                        ;; Destination.
1039                        (case (car target)
1040                          ('nil (format "file:%s" file))
1041                          (id (format "id:%s" (cdr target)))
1042                          (custom-id (format "file:%s::#%s" file (cdr target)))
1043                          (otherwise (format "file:%s::*%s" file (cdr target))))
1044                        ;; Description.
1045                        (car (last entry)))))
1046                   "\n"))))
1047             (setq current-letter letter last-entry entry))))
1048       ;; Create "theindex.org", if it doesn't exist yet, and provide
1049       ;; a default index file.
1050       (let ((index.org (expand-file-name "theindex.org" directory)))
1051         (unless (file-exists-p index.org)
1052           (with-temp-file index.org
1053             (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
1054
1055
1056 \f
1057 ;;; External Fuzzy Links Resolution
1058 ;;
1059 ;; This part implements tools to resolve [[file.org::*Some headline]]
1060 ;; links, where "file.org" belongs to the current project.
1061
1062 (defun org-publish-collect-numbering (output backend info)
1063   (org-publish-cache-set-file-property
1064    (plist-get info :input-file) :numbering
1065    (mapcar (lambda (entry)
1066              (cons (org-split-string
1067                     (replace-regexp-in-string
1068                      "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
1069                      (org-element-property :raw-value (car entry))))
1070                    (cdr entry)))
1071            (plist-get info :headline-numbering)))
1072   ;; Return output unchanged.
1073   output)
1074
1075 (defun org-publish-resolve-external-fuzzy-link (file fuzzy)
1076   "Return numbering for headline matching FUZZY search in FILE.
1077
1078 Return value is a list of numbers, or nil.  This function allows
1079 to resolve external fuzzy links like:
1080
1081   [[file.org::*fuzzy][description]]"
1082   (when org-publish-cache
1083     (cdr (assoc (org-split-string
1084                  (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
1085                 (org-publish-cache-get-file-property
1086                  (expand-file-name file) :numbering nil t)))))
1087
1088
1089 \f
1090 ;;; Caching functions
1091
1092 (defun org-publish-write-cache-file (&optional free-cache)
1093   "Write `org-publish-cache' to file.
1094 If FREE-CACHE, empty the cache."
1095   (unless org-publish-cache
1096     (error "`org-publish-write-cache-file' called, but no cache present"))
1097
1098   (let ((cache-file (org-publish-cache-get ":cache-file:")))
1099     (unless cache-file
1100       (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
1101     (with-temp-file cache-file
1102       (let (print-level print-length)
1103         (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
1104         (maphash (lambda (k v)
1105                    (insert
1106                     (format (concat "(puthash %S "
1107                                     (if (or (listp v) (symbolp v))
1108                                         "'" "")
1109                                     "%S org-publish-cache)\n") k v)))
1110                  org-publish-cache)))
1111     (when free-cache (org-publish-reset-cache))))
1112
1113 (defun org-publish-initialize-cache (project-name)
1114   "Initialize the projects cache if not initialized yet and return it."
1115
1116   (unless project-name
1117     (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
1118
1119   (unless (file-exists-p org-publish-timestamp-directory)
1120     (make-directory org-publish-timestamp-directory t))
1121   (unless (file-directory-p org-publish-timestamp-directory)
1122     (error "Org publish timestamp: %s is not a directory"
1123            org-publish-timestamp-directory))
1124
1125   (unless (and org-publish-cache
1126                (string= (org-publish-cache-get ":project:") project-name))
1127     (let* ((cache-file
1128             (concat
1129              (expand-file-name org-publish-timestamp-directory)
1130              project-name ".cache"))
1131            (cexists (file-exists-p cache-file)))
1132
1133       (when org-publish-cache (org-publish-reset-cache))
1134
1135       (if cexists (load-file cache-file)
1136         (setq org-publish-cache
1137               (make-hash-table :test 'equal :weakness nil :size 100))
1138         (org-publish-cache-set ":project:" project-name)
1139         (org-publish-cache-set ":cache-file:" cache-file))
1140       (unless cexists (org-publish-write-cache-file nil))))
1141   org-publish-cache)
1142
1143 (defun org-publish-reset-cache ()
1144   "Empty org-publish-cache and reset it nil."
1145   (message "%s" "Resetting org-publish-cache")
1146   (when (hash-table-p org-publish-cache)
1147     (clrhash org-publish-cache))
1148   (setq org-publish-cache nil))
1149
1150 (defun org-publish-cache-file-needs-publishing
1151   (filename &optional pub-dir pub-func base-dir)
1152   "Check the timestamp of the last publishing of FILENAME.
1153 Return non-nil if the file needs publishing.  Also check if
1154 any included files have been more recently published, so that
1155 the file including them will be republished as well."
1156   (unless org-publish-cache
1157     (error
1158      "`org-publish-cache-file-needs-publishing' called, but no cache present"))
1159   (let* ((case-fold-search t)
1160          (key (org-publish-timestamp-filename filename pub-dir pub-func))
1161          (pstamp (org-publish-cache-get key))
1162          (org-inhibit-startup t)
1163          (visiting (find-buffer-visiting filename))
1164          included-files-ctime buf)
1165     (when (equal (file-name-extension filename) "org")
1166       (setq buf (find-file (expand-file-name filename)))
1167       (with-current-buffer buf
1168         (goto-char (point-min))
1169         (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
1170           (let* ((element (org-element-at-point))
1171                  (included-file
1172                   (and (eq (org-element-type element) 'keyword)
1173                        (let ((value (org-element-property :value element)))
1174                          (and value
1175                               (string-match "^\\(\".+?\"\\|\\S-+\\)" value)
1176                               (org-remove-double-quotes
1177                                (match-string 1 value)))))))
1178             (when included-file
1179               (add-to-list 'included-files-ctime
1180                            (org-publish-cache-ctime-of-src
1181                             (expand-file-name included-file))
1182                            t)))))
1183       (unless visiting (kill-buffer buf)))
1184     (if (null pstamp) t
1185       (let ((ctime (org-publish-cache-ctime-of-src filename)))
1186         (or (< pstamp ctime)
1187             (when included-files-ctime
1188               (not (null (delq nil (mapcar (lambda (ct) (< ctime ct))
1189                                            included-files-ctime))))))))))
1190
1191 (defun org-publish-cache-set-file-property
1192   (filename property value &optional project-name)
1193   "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
1194 Use cache file of PROJECT-NAME.  If the entry does not exist, it
1195 will be created.  Return VALUE."
1196   ;; Evtl. load the requested cache file:
1197   (if project-name (org-publish-initialize-cache project-name))
1198   (let ((pl (org-publish-cache-get filename)))
1199     (if pl (progn (plist-put pl property value) value)
1200       (org-publish-cache-get-file-property
1201        filename property value nil project-name))))
1202
1203 (defun org-publish-cache-get-file-property
1204   (filename property &optional default no-create project-name)
1205   "Return the value for a PROPERTY of file FILENAME in publishing cache.
1206 Use cache file of PROJECT-NAME. Return the value of that PROPERTY
1207 or DEFAULT, if the value does not yet exist.  If the entry will
1208 be created, unless NO-CREATE is not nil."
1209   ;; Evtl. load the requested cache file:
1210   (if project-name (org-publish-initialize-cache project-name))
1211   (let ((pl (org-publish-cache-get filename)) retval)
1212     (if pl
1213         (if (plist-member pl property)
1214             (setq retval (plist-get pl property))
1215           (setq retval default))
1216       ;; no pl yet:
1217       (unless no-create
1218         (org-publish-cache-set filename (list property default)))
1219       (setq retval default))
1220     retval))
1221
1222 (defun org-publish-cache-get (key)
1223   "Return the value stored in `org-publish-cache' for key KEY.
1224 Returns nil, if no value or nil is found, or the cache does not
1225 exist."
1226   (unless org-publish-cache
1227     (error "`org-publish-cache-get' called, but no cache present"))
1228   (gethash key org-publish-cache))
1229
1230 (defun org-publish-cache-set (key value)
1231   "Store KEY VALUE pair in `org-publish-cache'.
1232 Returns value on success, else nil."
1233   (unless org-publish-cache
1234     (error "`org-publish-cache-set' called, but no cache present"))
1235   (puthash key value org-publish-cache))
1236
1237 (defun org-publish-cache-ctime-of-src (file)
1238   "Get the ctime of FILE as an integer."
1239   (let ((attr (file-attributes
1240                (expand-file-name (or (file-symlink-p file) file)
1241                                  (file-name-directory file)))))
1242     (if (not attr) (error "No such file: \"%s\"" file)
1243       (+ (lsh (car (nth 5 attr)) 16)
1244          (cadr (nth 5 attr))))))
1245
1246
1247 (provide 'ox-publish)
1248
1249 ;; Local variables:
1250 ;; generated-autoload-file: "org-loaddefs.el"
1251 ;; End:
1252
1253 ;;; ox-publish.el ends here