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