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