lisp/org-publish.el

   1 ;;; org-publish.el --- publish related org-mode files as a website
   2 ;; Copyright (C) 2006, 2007, 2008, 2009  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 ;; Version: 6.34trans
   8
   9 ;; This file is part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This program allow configurable publishing of related sets of
  27 ;; Org-mode files as a complete website.
  28 ;;
  29 ;; org-publish.el can do the following:
  30 ;;
  31 ;; + Publish all one's org-files to HTML or PDF
  32 ;; + Upload HTML, images, attachments and other files to a web server
  33 ;; + Exclude selected private pages from publishing
  34 ;; + Publish a clickable sitemap of pages
  35 ;; + Manage local timestamps for publishing only changed files
  36 ;; + Accept plugin functions to extend range of publishable content
  37 ;;
  38 ;; Documentation for publishing is in the manual.
  39
  40 ;;; Code:
  41
  42
  43 (defun org-publish-sanitize-plist (plist)
  44   (mapcar (lambda (x)
  45             (or (cdr (assq x '((:index-filename . :sitemap-filename)
  46                                (:index-title . :sitemap-title)
  47                                (:index-function . :sitemap-function)
  48                                (:index-style . :sitemap-style)
  49                                (:auto-index . :auto-sitemap))))
  50                 x))
  51           plist))
  52
  53 (eval-when-compile
  54   (require 'cl))
  55 (require 'org)
  56 (require 'org-exp)
  57
  58 (eval-and-compile
  59   (unless (fboundp 'declare-function)
  60     (defmacro declare-function (fn file &optional arglist fileonly))))
  61
  62 (defgroup org-publish nil
  63   "Options for publishing a set of Org-mode and related files."
  64   :tag "Org Publishing"
  65   :group 'org)
  66
  67 (defcustom org-publish-project-alist nil
  68   "Association list to control publishing behavior.
  69 Each element of the alist is a publishing 'project.'  The CAR of
  70 each element is a string, uniquely identifying the project.  The
  71 CDR of each element is in one of the following forms:
  72
  73   (:property value :property value ... )
  74
  75 OR,
  76
  77   (:components (\"project-1\" \"project-2\" ...))
  78
  79 When the CDR of an element of org-publish-project-alist is in
  80 this second form, the elements of the list after :components are
  81 taken to be components of the project, which group together files
  82 requiring different publishing options.  When you publish such a
  83 project with \\[org-publish], the components all publish.
  84
  85 When a property is given a value in org-publish-project-alist, its
  86 setting overrides the value of the corresponding user variable
  87 \(if any) during publishing.  However, options set within a file
  88 override everything.
  89
  90 Most properties are optional, but some should always be set:
  91
  92   :base-directory        Directory containing publishing source files
  93   :base-extension        Extension (without the dot!) of source files.
  94                          This can be a regular expression.
  95   :publishing-directory  Directory (possibly remote) where output
  96                          files will be published
  97
  98 The :exclude property may be used to prevent certain files from
  99 being published.  Its value may be a string or regexp matching
 100 file names you don't want to be published.
 101
 102 The :include property may be used to include extra files.  Its
 103 value may be a list of filenames to include. The filenames are
 104 considered relative to the base directory.
 105
 106 When both :include and :exclude properties are given values, the
 107 exclusion step happens first.
 108
 109 One special property controls which back-end function to use for
 110 publishing files in the project.  This can be used to extend the
 111 set of file types publishable by org-publish, as well as the set
 112 of output formats.
 113
 114   :publishing-function     Function to publish file.  The default is
 115                            `org-publish-org-to-html', but other
 116                            values are possible.  May also be a
 117                            list of functions, in which case
 118                            each function in the list is invoked
 119                            in turn.
 120
 121 Another property allows you to insert code that prepares a
 122 project for publishing.  For example, you could call GNU Make on a
 123 certain makefile, to ensure published files are built up to date.
 124
 125   :preparation-function   Function to be called before publishing
 126                           this project.  This may also be a list
 127                           of functions.
 128   :completion-function    Function to be called after publishing
 129                           this project.  This may also be a list
 130                           of functions.
 131
 132 Some properties control details of the Org publishing process,
 133 and are equivalent to the corresponding user variables listed in
 134 the right column.  See the documentation for those variables to
 135 learn more about their use and default values.
 136
 137   :language              `org-export-default-language'
 138   :headline-levels       `org-export-headline-levels'
 139   :section-numbers       `org-export-with-section-numbers'
 140   :table-of-contents     `org-export-with-toc'
 141   :emphasize             `org-export-with-emphasize'
 142   :sub-superscript       `org-export-with-sub-superscripts'
 143   :TeX-macros            `org-export-with-TeX-macros'
 144   :fixed-width           `org-export-with-fixed-width'
 145   :tables                `org-export-with-tables'
 146   :table-auto-headline   `org-export-highlight-first-table-line'
 147   :style                 `org-export-html-style'
 148   :convert-org-links     `org-export-html-link-org-files-as-html'
 149   :inline-images         `org-export-html-inline-images'
 150   :expand-quoted-html    `org-export-html-expand'
 151   :timestamp             `org-export-html-with-timestamp'
 152   :publishing-directory  `org-export-publishing-directory'
 153   :preamble              `org-export-html-preamble'
 154   :postamble             `org-export-html-postamble'
 155   :auto-preamble         `org-export-html-auto-preamble'
 156   :auto-postamble        `org-export-html-auto-postamble'
 157   :author                `user-full-name'
 158   :email                 `user-mail-address'
 159
 160 The following properties may be used to control publishing of a
 161 sitemap of files or summary page for a given project.
 162
 163   :auto-sitemap           Whether to publish a sitemap during
 164                          `org-publish-current-project' or `org-publish-all'.
 165   :sitemap-filename      Filename for output of sitemap.  Defaults
 166                          to 'sitemap.org' (which becomes 'sitemap.html').
 167   :sitemap-title         Title of sitemap page.  Defaults to name of file.
 168   :sitemap-function      Plugin function to use for generation of sitemap.
 169                          Defaults to `org-publish-org-sitemap', which
 170                          generates a plain list of links to all files
 171                          in the project.
 172   :sitemap-style         Can be `list' (sitemap is just an itemized list
 173                          of the titles of the files involved) or
 174                          `tree' (the directory structure of the source
 175                          files is reflected in the sitemap).  Defaults to
 176                          `tree'."
 177   :group 'org-publish
 178   :type 'alist)
 179
 180 (defcustom org-publish-use-timestamps-flag t
 181   "When non-nil, use timestamp checking to publish only changed files.
 182 When nil, do no timestamp checking and always publish all files."
 183   :group 'org-publish
 184   :type 'boolean)
 185
 186 (defcustom org-publish-timestamp-directory (convert-standard-filename
 187                                             "~/.org-timestamps/")
 188   "Name of directory in which to store publishing timestamps."
 189   :group 'org-publish
 190   :type 'directory)
 191
 192 (defcustom org-publish-list-skipped-files t
 193   "Non-nil means show message about files *not* published."
 194   :group 'org-publish
 195   :type 'boolean)
 196
 197 (defcustom org-publish-before-export-hook nil
 198   "Hook run before export on the Org file.
 199 The hook may modify the file in arbitrary ways before publishing happens.
 200 The original version of the buffer will be restored after publishing."
 201   :group 'org-publish
 202   :type 'hook)
 203
 204 (defcustom org-publish-after-export-hook nil
 205   "Hook run after export on the exported buffer.
 206 Any changes made by this hook will be saved."
 207   :group 'org-publish
 208   :type 'hook)
 209
 210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 211 ;;; Timestamp-related functions
 212
 213 (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
 214   "Return path to timestamp file for filename FILENAME."
 215   (setq filename (concat filename "::" (or pub-dir "") "::"
 216                          (format "%s" (or pub-func ""))))
 217   (concat (file-name-as-directory org-publish-timestamp-directory)
 218           "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
 219
 220 (defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
 221   "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC.
 222 TRUE-PUB-DIR is there the file will truely end up.  Currently we are not using
 223 this - maybe it can eventually be used to check if the file is present at
 224 the target location, and how old it is.  Right ow we cannot do this, because
 225 we do not know under what file name the file will be stored - the publishing
 226 function can still decide about that independently."
 227   (let ((rtn
 228          (if org-publish-use-timestamps-flag
 229              (if (file-exists-p org-publish-timestamp-directory)
 230                  ;; first handle possible wrong timestamp directory
 231                  (if (not (file-directory-p org-publish-timestamp-directory))
 232                      (error "Org publish timestamp: %s is not a directory"
 233                             org-publish-timestamp-directory)
 234                    ;; there is a timestamp, check if FILENAME is newer
 235                    (file-newer-than-file-p
 236                     filename (org-publish-timestamp-filename
 237                               filename pub-dir pub-func)))
 238                (make-directory org-publish-timestamp-directory)
 239                t)
 240            ;; don't use timestamps, always return t
 241            t)))
 242     (if rtn
 243         (message "Publishing file %s using `%s'" filename pub-func)
 244       (when org-publish-list-skipped-files
 245         (message   "Skipping unmodified file %s" filename)))
 246     rtn))
 247
 248 (defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
 249   "Update publishing timestamp for file FILENAME.
 250 If there is no timestamp, create one."
 251   (let ((timestamp-file (org-publish-timestamp-filename
 252                          filename pub-dir pub-func))
 253         newly-created-timestamp)
 254     (if (not (file-exists-p timestamp-file))
 255         ;; create timestamp file if needed
 256         (with-temp-buffer
 257           (make-directory (file-name-directory timestamp-file) t)
 258           (write-file timestamp-file)
 259           (setq newly-created-timestamp t)))
 260     ;; Emacs 21 doesn't have `set-file-times'
 261     (if (and (fboundp 'set-file-times)
 262              (not newly-created-timestamp))
 263         (set-file-times timestamp-file)
 264       (call-process "touch" nil 0 nil (expand-file-name timestamp-file)))))
 265
 266 (defun org-publish-remove-all-timestamps ()
 267   "Remove all files in the timstamp directory."
 268   (let ((dir org-publish-timestamp-directory)
 269         files)
 270     (when (and (file-exists-p dir)
 271                (file-directory-p dir))
 272       (mapc 'delete-file (directory-files dir 'full "[^.]\\'")))))
 273
 274
 275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 276 ;;; Mapping files to project names
 277
 278 (defvar org-publish-files-alist nil
 279   "Alist of files and their parent projects.
 280 Each element of this alist is of the form:
 281
 282   (file-name . project-name)")
 283
 284 (defvar org-publish-initial-buffer nil
 285   "The buffer `org-publish' has been called from.")
 286 (defvar org-publish-temp-files nil
 287   "Temporary list of files to be published.")
 288
 289 (defun org-publish-initialize-files-alist (&optional refresh)
 290   "Set `org-publish-files-alist' if it is not set.
 291 Also set it if the optional argument REFRESH is non-nil."
 292   (interactive "P")
 293   (when (or refresh (not org-publish-files-alist))
 294     (setq org-publish-files-alist
 295           (org-publish-get-files org-publish-project-alist))))
 296
 297 (defun org-publish-validate-link (link &optional directory)
 298   "Check if LINK points to a file in the current project."
 299   (assoc (expand-file-name link directory) org-publish-files-alist))
 300
 301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 302 ;;; Compatibility aliases
 303
 304 ;; Delete-dups is not in Emacs <22
 305 (if (fboundp 'delete-dups)
 306     (defalias 'org-publish-delete-dups 'delete-dups)
 307   (defun org-publish-delete-dups (list)
 308     "Destructively remove `equal' duplicates from LIST.
 309 Store the result in LIST and return it.  LIST must be a proper list.
 310 Of several `equal' occurrences of an element in LIST, the first
 311 one is kept.
 312
 313 This is a compatibility function for Emacsen without `delete-dups'."
 314     ;; Code from `subr.el' in Emacs 22:
 315     (let ((tail list))
 316       (while tail
 317         (setcdr tail (delete (car tail) (cdr tail)))
 318         (setq tail (cdr tail))))
 319     list))
 320
 321 (declare-function org-publish-delete-dups "org-publish" (list))
 322 (declare-function find-lisp-find-files "find-lisp" (directory regexp))
 323
 324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 325 ;;; Getting project information out of org-publish-project-alist
 326
 327 (defun org-publish-get-files (projects-alist &optional no-exclusion)
 328   "Return the list of all publishable files for PROJECTS-ALIST.
 329 If NO-EXCLUSION is non-nil, don't exclude files."
 330   (let (all-files)
 331     ;; add all projects
 332     (mapc
 333      (lambda(p)
 334        (let* ((exclude (plist-get (cdr p) :exclude))
 335               (files (and p (org-publish-get-base-files p exclude))))
 336          ;; add all files from this project
 337          (mapc (lambda(f)
 338                  (add-to-list 'all-files
 339                               (cons (expand-file-name f) (car p))))
 340                files)))
 341      (org-publish-expand-projects projects-alist))
 342     all-files))
 343
 344 (defun org-publish-expand-projects (projects-alist)
 345   "Expand projects in PROJECTS-ALIST.
 346 This splices all the components into the list."
 347   (let ((rest projects-alist) rtn p components)
 348     (while (setq p (pop rest))
 349       (if (setq components (plist-get (cdr p) :components))
 350           (setq rest (append
 351                       (mapcar (lambda (x) (assoc x org-publish-project-alist))
 352                               components)
 353                       rest))
 354         (push p rtn)))
 355     (nreverse (org-publish-delete-dups (delq nil rtn)))))
 356
 357 (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
 358   "Set `org-publish-temp-files' with files from BASE-DIR directory.
 359 If RECURSE is non-nil, check BASE-DIR recursively.  If MATCH is
 360 non-nil, restrict this list to the files matching the regexp
 361 MATCH.  If SKIP-FILE is non-nil, skip file matching the regexp
 362 SKIP-FILE.  If SKIP-DIR is non-nil, don't check directories
 363 matching the regexp SKIP-DIR when recursing through BASE-DIR."
 364   (mapc (lambda (f)
 365           (let ((fd-p (file-directory-p f))
 366                 (fnd (file-name-nondirectory f)))
 367             (if (and fd-p recurse
 368                      (not (string-match "^\\.+$" fnd))
 369                      (if skip-dir (not (string-match skip-dir fnd)) t))
 370                 (org-publish-get-base-files-1 f recurse match skip-file skip-dir)
 371               (unless (or fd-p ;; this is a directory
 372                           (and skip-file (string-match skip-file fnd))
 373                           (not (file-exists-p (file-truename f)))
 374                           (not (string-match match fnd)))
 375                 (pushnew f org-publish-temp-files)))))
 376         (directory-files base-dir t (unless recurse match))))
 377
 378 (defun org-publish-get-base-files (project &optional exclude-regexp)
 379   "Return a list of all files in PROJECT.
 380 If EXCLUDE-REGEXP is set, this will be used to filter out
 381 matching filenames."
 382   (let* ((project-plist (cdr project))
 383          (base-dir (file-name-as-directory
 384                     (plist-get project-plist :base-directory)))
 385          (include-list (plist-get project-plist :include))
 386          (recurse (plist-get project-plist :recursive))
 387          (extension (or (plist-get project-plist :base-extension) "org"))
 388          (match (if (eq extension 'any)
 389                     "^[^\\.]"
 390                   (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
 391     (setq org-publish-temp-files nil)
 392     (org-publish-get-base-files-1 base-dir recurse match
 393                                   ;; FIXME distinguish exclude regexp
 394                                   ;; for skip-file and skip-dir?
 395                                   exclude-regexp exclude-regexp)
 396     (mapc (lambda (f)
 397             (pushnew
 398              (expand-file-name (concat base-dir f))
 399              org-publish-temp-files))
 400           include-list)
 401     org-publish-temp-files))
 402
 403 (defun org-publish-get-project-from-filename (filename &optional up)
 404   "Return the project FILENAME belongs."
 405   (let* ((project-name (cdr (assoc (expand-file-name filename)
 406                                    org-publish-files-alist))))
 407     (when up
 408       (dolist (prj org-publish-project-alist)
 409         (if (member project-name (plist-get (cdr prj) :components))
 410             (setq project-name (car prj)))))
 411     (assoc project-name org-publish-project-alist)))
 412
 413 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 414 ;;; Pluggable publishing back-end functions
 415
 416 (defun org-publish-org-to (format plist filename pub-dir)
 417   "Publish an org file to FORMAT.
 418 PLIST is the property list for the given project.
 419 FILENAME is the filename of the org file to be published.
 420 PUB-DIR is the publishing directory."
 421   (require 'org)
 422   (unless (file-exists-p pub-dir)
 423     (make-directory pub-dir t))
 424   (let ((visiting (find-buffer-visiting filename)))
 425     (save-excursion
 426       (switch-to-buffer (or visiting (find-file filename)))
 427       (let* ((plist (cons :buffer-will-be-killed (cons t plist)))
 428              (init-buf (current-buffer))
 429              (init-point (point))
 430              (init-buf-string (buffer-string))
 431              export-buf-or-file)
 432         ;; run hooks before exporting
 433         (run-hooks 'org-publish-before-export-hook)
 434         ;; export the possibly modified buffer
 435         (setq export-buf-or-file
 436               (funcall (intern (concat "org-export-as-" format))
 437                        (plist-get plist :headline-levels)
 438                        nil plist nil nil pub-dir))
 439         (when (and (bufferp export-buf-or-file)
 440                    (buffer-live-p export-buf-or-file))
 441           (set-buffer export-buf-or-file)
 442           ;; run hooks after export and save export
 443           (progn (run-hooks 'org-publish-after-export-hook)
 444                  (if (buffer-modified-p) (save-buffer)))
 445           (kill-buffer export-buf-or-file))
 446         ;; maybe restore buffer's content
 447         (set-buffer init-buf)
 448         (when (buffer-modified-p init-buf)
 449           (erase-buffer)
 450           (insert init-buf-string)
 451           (save-buffer)
 452           (goto-char init-point))
 453         (unless visiting
 454           (kill-buffer init-buf))))))
 455
 456 (defmacro org-publish-with-aux-preprocess-maybe (&rest body)
 457   "Execute BODY with a modified hook to preprocess for index."
 458   `(let ((org-export-preprocess-after-headline-targets-hook
 459          (if (plist-get project-plist :makeindex)
 460              (cons 'org-publish-aux-preprocess
 461                    org-export-preprocess-after-headline-targets-hook)
 462            org-export-preprocess-after-headline-targets-hook)))
 463      ,@body))
 464
 465 (defvar project-plist)
 466 (defun org-publish-org-to-latex (plist filename pub-dir)
 467   "Publish an org file to LaTeX.
 468 See `org-publish-org-to' to the list of arguments."
 469   (org-publish-with-aux-preprocess-maybe
 470    (org-publish-org-to "latex" plist filename pub-dir)))
 471
 472 (defun org-publish-org-to-pdf (plist filename pub-dir)
 473   "Publish an org file to PDF (via LaTeX).
 474 See `org-publish-org-to' to the list of arguments."
 475   (org-publish-with-aux-preprocess-maybe
 476    (org-publish-org-to "pdf" plist filename pub-dir)))
 477
 478 (defun org-publish-org-to-html (plist filename pub-dir)
 479   "Publish an org file to HTML.
 480 See `org-publish-org-to' to the list of arguments."
 481   (org-publish-with-aux-preprocess-maybe
 482     (org-publish-org-to "html" plist filename pub-dir)))
 483
 484 (defun org-publish-org-to-org (plist filename pub-dir)
 485   "Publish an org file to HTML.
 486 See `org-publish-org-to' to the list of arguments."
 487   (org-publish-org-to "org" plist filename pub-dir))
 488
 489 (defun org-publish-attachment (plist filename pub-dir)
 490   "Publish a file with no transformation of any kind.
 491 See `org-publish-org-to' to the list of arguments."
 492   ;; make sure eshell/cp code is loaded
 493   (unless (file-directory-p pub-dir)
 494     (make-directory pub-dir t))
 495   (or (equal (expand-file-name (file-name-directory filename))
 496              (file-name-as-directory (expand-file-name pub-dir)))
 497       (copy-file filename
 498                  (expand-file-name (file-name-nondirectory filename) pub-dir)
 499                  t)))
 500
 501 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 502 ;;; Publishing files, sets of files, and indices
 503
 504 (defun org-publish-file (filename &optional project)
 505   "Publish file FILENAME from PROJECT."
 506   (let* ((project
 507           (or project
 508               (or (org-publish-get-project-from-filename filename)
 509                   (if (y-or-n-p
 510                        (format "%s is not in a project.  Re-read the list of projects files? "
 511                                (abbreviate-file-name filename)))
 512                       ;; If requested, re-initialize the list of projects files
 513                       (progn (org-publish-initialize-files-alist t)
 514                              (or (org-publish-get-project-from-filename filename)
 515                                  (error "File %s not part of any known project"
 516                                         (abbreviate-file-name filename))))
 517                     (error "Can't publish file outside of a project")))))
 518          (project-plist (cdr project))
 519          (ftname (file-truename filename))
 520          (publishing-function
 521           (or (plist-get project-plist :publishing-function)
 522               'org-publish-org-to-html))
 523          (base-dir (file-name-as-directory
 524                     (file-truename (plist-get project-plist :base-directory))))
 525          (pub-dir (file-name-as-directory
 526                    (file-truename (plist-get project-plist :publishing-directory))))
 527          tmp-pub-dir)
 528     (setq tmp-pub-dir
 529           (file-name-directory
 530            (concat pub-dir
 531                    (and (string-match (regexp-quote base-dir) ftname)
 532                         (substring ftname (match-end 0))))))
 533     (if (listp publishing-function)
 534         ;; allow chain of publishing functions
 535         (mapc (lambda (f)
 536                 (when (org-publish-needed-p filename pub-dir f tmp-pub-dir)
 537                   (funcall f project-plist filename tmp-pub-dir)
 538                   (org-publish-update-timestamp filename pub-dir f)))
 539               publishing-function)
 540       (when (org-publish-needed-p filename pub-dir publishing-function
 541                                   tmp-pub-dir)
 542         (funcall publishing-function project-plist filename tmp-pub-dir)
 543         (org-publish-update-timestamp
 544          filename pub-dir publishing-function)))))
 545
 546 (defun org-publish-projects (projects)
 547   "Publish all files belonging to the PROJECTS alist.
 548 If :auto-sitemap is set, publish the sitemap too.
 549 If :makeindex is set, also produce a file theindex.org."
 550   (mapc
 551    (lambda (project)
 552      (let*
 553          ((project-plist (cdr project))
 554           (exclude-regexp (plist-get project-plist :exclude))
 555           (sitemap-p (plist-get project-plist :auto-sitemap))
 556           (sitemap-filename (or (plist-get project-plist :sitemap-filename)
 557                                 "sitemap.org"))
 558           (sitemap-function (or (plist-get project-plist :sitemap-function)
 559                                 'org-publish-org-sitemap))
 560           (preparation-function (plist-get project-plist :preparation-function))
 561           (completion-function (plist-get project-plist :completion-function))
 562           (files (org-publish-get-base-files project exclude-regexp)) file)
 563        (when preparation-function (run-hooks 'preparation-function))
 564        (if sitemap-p (funcall sitemap-function project sitemap-filename))
 565        (while (setq file (pop files))
 566          (org-publish-file file project))
 567        (when (plist-get project-plist :makeindex)
 568          (org-publish-index-generate-theindex.inc
 569           (plist-get project-plist :base-directory))
 570          (org-publish-file (expand-file-name
 571                             "theindex.org"
 572                             (plist-get project-plist :base-directory))
 573                            project))
 574        (when completion-function (run-hooks 'completion-function))))
 575    (org-publish-expand-projects projects)))
 576
 577 (defun org-publish-org-sitemap (project &optional sitemap-filename)
 578   "Create an sitemap of pages in set defined by PROJECT.
 579 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 580 Default for SITEMAP-FILENAME is 'sitemap.org'."
 581   (let* ((project-plist (cdr project))
 582          (dir (file-name-as-directory
 583                (plist-get project-plist :base-directory)))
 584          (localdir (file-name-directory dir))
 585          (indent-str (make-string 2 ?\ ))
 586          (exclude-regexp (plist-get project-plist :exclude))
 587          (files (nreverse (org-publish-get-base-files project exclude-regexp)))
 588          (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
 589          (sitemap-title (or (plist-get project-plist :sitemap-title)
 590                           (concat "Sitemap for project " (car project))))
 591          (sitemap-style (or (plist-get project-plist :sitemap-style)
 592                           'tree))
 593          (visiting (find-buffer-visiting sitemap-filename))
 594          (ifn (file-name-nondirectory sitemap-filename))
 595          file sitemap-buffer)
 596     (with-current-buffer (setq sitemap-buffer
 597                                (or visiting (find-file sitemap-filename)))
 598       (erase-buffer)
 599       (insert (concat "#+TITLE: " sitemap-title "\n\n"))
 600       (while (setq file (pop files))
 601         (let ((fn (file-name-nondirectory file))
 602               (link (file-relative-name file dir))
 603               (oldlocal localdir))
 604           ;; sitemap shouldn't list itself
 605           (unless (equal (file-truename sitemap-filename)
 606                          (file-truename file))
 607             (if (eq sitemap-style 'list)
 608                 (message "Generating list-style sitemap for %s" sitemap-title)
 609               (message "Generating tree-style sitemap for %s" sitemap-title)
 610               (setq localdir (concat (file-name-as-directory dir)
 611                                      (file-name-directory link)))
 612               (unless (string= localdir oldlocal)
 613                 (if (string= localdir dir)
 614                     (setq indent-str (make-string 2 ?\ ))
 615                   (let ((subdirs
 616                          (split-string
 617                           (directory-file-name
 618                            (file-name-directory
 619                             (file-relative-name localdir dir))) "/"))
 620                         (subdir "")
 621                         (old-subdirs (split-string
 622                                       (file-relative-name oldlocal dir) "/")))
 623                     (setq indent-str (make-string 2 ?\ ))
 624                     (while (string= (car old-subdirs) (car subdirs))
 625                       (setq indent-str (concat indent-str (make-string 2 ?\ )))
 626                       (pop old-subdirs)
 627                       (pop subdirs))
 628                     (dolist (d subdirs)
 629                       (setq subdir (concat subdir d "/"))
 630                       (insert (concat indent-str " + " d "\n"))
 631                       (setq indent-str (make-string
 632                                         (+ (length indent-str) 2) ?\ )))))))
 633             ;; This is common to 'flat and 'tree
 634             (insert (concat indent-str " + [[file:" link "]["
 635                             (org-publish-find-title file)
 636                             "]]\n")))))
 637       (save-buffer))
 638     (or visiting (kill-buffer sitemap-buffer))))
 639
 640 (defun org-publish-find-title (file)
 641   "Find the title of file in project."
 642   (let* ((visiting (find-buffer-visiting file))
 643          (buffer (or visiting (find-file-noselect file)))
 644          title)
 645     (with-current-buffer buffer
 646       (let* ((opt-plist (org-combine-plists (org-default-export-plist)
 647                                             (org-infile-export-plist))))
 648         (setq title
 649               (or (plist-get opt-plist :title)
 650                   (and (not
 651                         (plist-get opt-plist :skip-before-1st-heading))
 652                        (org-export-grab-title-from-buffer))
 653                   (file-name-nondirectory (file-name-sans-extension file))))))
 654     (unless visiting
 655       (kill-buffer buffer))
 656     title))
 657
 658 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 659 ;;; Interactive publishing functions
 660
 661 ;;;###autoload
 662 (defalias 'org-publish-project 'org-publish)
 663
 664 ;;;###autoload
 665 (defun org-publish (project &optional force)
 666   "Publish PROJECT."
 667   (interactive
 668    (list
 669     (assoc (org-icompleting-read
 670             "Publish project: "
 671             org-publish-project-alist nil t)
 672            org-publish-project-alist)
 673     current-prefix-arg))
 674   (setq org-publish-initial-buffer (current-buffer))
 675   (save-window-excursion
 676     (let* ((org-publish-use-timestamps-flag
 677             (if force nil org-publish-use-timestamps-flag)))
 678       (org-publish-projects (list project)))))
 679
 680 ;;;###autoload
 681 (defun org-publish-all (&optional force)
 682   "Publish all projects.
 683 With prefix argument, remove all files in the timestamp
 684 directory and force publishing all files."
 685   (interactive "P")
 686   (when force
 687     (org-publish-remove-all-timestamps))
 688   (org-publish-initialize-files-alist force)
 689   (save-window-excursion
 690     (let ((org-publish-use-timestamps-flag
 691            (if force nil org-publish-use-timestamps-flag)))
 692       (org-publish-projects org-publish-project-alist))))
 693
 694
 695 ;;;###autoload
 696 (defun org-publish-current-file (&optional force)
 697   "Publish the current file.
 698 With prefix argument, force publish the file."
 699   (interactive "P")
 700   (org-publish-initialize-files-alist force)
 701   (save-window-excursion
 702     (let ((org-publish-use-timestamps-flag
 703            (if force nil org-publish-use-timestamps-flag)))
 704       (org-publish-file (buffer-file-name)))))
 705
 706 ;;;###autoload
 707 (defun org-publish-current-project (&optional force)
 708   "Publish the project associated with the current file.
 709 With a prefix argument, force publishing of all files in
 710 the project."
 711   (interactive "P")
 712   (org-publish-initialize-files-alist force)
 713   (save-window-excursion
 714     (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
 715           (org-publish-use-timestamps-flag
 716            (if force nil org-publish-use-timestamps-flag)))
 717       (if (not project)
 718           (error "File %s is not part of any known project" (buffer-file-name)))
 719       (org-publish project))))
 720
 721
 722 ;;; Index generation
 723
 724 (defvar backend) ; dynamically scoped
 725 (defun org-publish-aux-preprocess ()
 726   "Find index entries and write them to an .orgx file."
 727   (let (entry index target)
 728     (goto-char (point-min))
 729     (while
 730         (and
 731          (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
 732          (> (match-end 1) (match-beginning 1)))
 733       (setq entry (match-string 1))
 734       (when (eq backend 'latex)
 735         (replace-match (format "\\index{%s}" entry) t t))
 736       (save-excursion
 737         (org-back-to-heading t)
 738         (setq target (get-text-property (point) 'target))
 739         (setq target (or (cdr (assoc target org-export-preferred-target-alist))
 740                          (cdr (assoc target org-export-id-target-alist))
 741                          target))
 742         (push (cons entry target) index)))
 743     (with-temp-file
 744         (concat (file-name-sans-extension org-current-export-file) ".orgx")
 745       (dolist (entry (nreverse index))
 746         (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
 747
 748 (defun org-publish-index-generate-theindex.inc (directory)
 749   "Generate the index from all .orgx files in the current directory and below."
 750   (require 'find-lisp)
 751   (let* ((fulldir (file-name-as-directory
 752                    (expand-file-name directory)))
 753          (full-files (find-lisp-find-files directory "\\.orgx\\'"))
 754          (re (concat "\\`" fulldir))
 755          (files (mapcar (lambda (f) (if (string-match re f)
 756                                         (substring f (match-end 0))
 757                                       f))
 758                         full-files))
 759          (default-directory directory)
 760          index origfile buf target entry ibuffer
 761          main last-main letter last-letter file sub link)
 762     ;; `files' contains the list of relative file names
 763     (dolist (file files)
 764       (setq origfile (substring file 0 -1))
 765       (setq buf (find-file-noselect file))
 766       (with-current-buffer buf
 767         (goto-char (point-min))
 768         (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t)
 769           (setq target (match-string 1)
 770                 entry (match-string 2))
 771           (push (list entry origfile target) index)))
 772       (kill-buffer buf))
 773     (setq index (sort index (lambda (a b) (string< (downcase (car a))
 774                                                    (downcase (car b))))))
 775     (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
 776     (with-current-buffer ibuffer
 777       (erase-buffer)
 778       (insert "* Index\n")
 779       (setq last-letter nil)
 780       (dolist (idx index)
 781         (setq entry (car idx) file (nth 1 idx) target (nth 2 idx))
 782         (setq letter (upcase (substring entry 0 1)))
 783         (when (not (equal letter last-letter))
 784           (insert "** " letter "\n")
 785           (setq last-letter letter))
 786         (if (string-match "!" entry)
 787             (setq main (substring entry 0 (match-beginning 0))
 788                   sub (substring entry (match-end 0)))
 789           (setq main nil sub nil last-main nil))
 790         (when (and main (not (equal main last-main)))
 791           (insert "   - " main "\n")
 792           (setq last-main main))
 793         (setq link (concat "[[file:" file "::#" target "]"
 794                            "[" (or sub entry) "]]"))
 795         (if (and main sub)
 796             (insert "     - " link "\n")
 797           (insert "   - " link "\n")))
 798       (save-buffer))
 799     (kill-buffer ibuffer)
 800
 801     (let ((index-file (expand-file-name "theindex.org" directory)))
 802       (unless (file-exists-p index-file)
 803         (setq ibuffer (find-file-noselect index-file))
 804         (with-current-buffer ibuffer
 805           (erase-buffer)
 806           (insert "\n\n#+include: \"theindex.inc\"\n\n")
 807           (save-buffer))
 808         (kill-buffer ibuffer)))))
 809
 810 (provide 'org-publish)
 811
 812
 813 ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
 814
 815 ;;; org-publish.el ends here