EXPERIMENTAL/org-export.el

   1 ;;; org-export.el --- Export engine for Org
   2 ;;
   3 ;; Copyright 2008 2010 Bastien Guerry
   4 ;;
   5 ;; Emacs Lisp Archive Entry
   6 ;; Filename: org-export.el
   7 ;; Version: 0.3
   8 ;; Author: Bastien <bzg AT altern DOT org>
   9 ;; Maintainer: Bastien <bzg AT altern DOT org>
  10 ;; Keywords:
  11 ;; Description:
  12 ;; URL: [Not distributed yet]
  13 ;;
  14 ;; This program is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 3, or (at your option)
  17 ;; any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; if not, write to the Free Software
  26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27 ;;
  28 ;;; Commentary:
  29 ;;
  30 ;; org-export.el implements a new experimental export engine for Org.
  31 ;;
  32 ;; Put this file into your load-path and the following into your ~/.emacs:
  33 ;;   (require 'org-export)
  34 ;;
  35 ;;; Todo:
  36 ;;
  37 ;; Rewrite `org-export-export-preprocess-string'.
  38 ;;
  39 ;;; Code:
  40
  41 (eval-when-compile
  42   (require 'cl))
  43
  44 ;;; Preparation functions:
  45
  46 (defvar org-export-structure nil)
  47 (defvar org-export-content nil)
  48 (defvar org-export-properties nil)
  49
  50 (defun org-export-set-backend (suffix)
  51   "Set the backend functions names from SUFFIX."
  52   (setq org-export-structure
  53         `((header ,(intern (concat "org-" suffix "-export-header")))
  54           (first-lines ,(intern (concat "org-" suffix "-export-first-lines")))
  55           (section-beginning ,(intern (concat "org-" suffix "-export-section-beginning")))
  56           (heading ,(intern (concat "org-" suffix "-export-heading")))
  57           (section-end ,(intern (concat "org-" suffix "-export-section-end")))
  58           (footer ,(intern (concat "org-" suffix "-export-footer")))))
  59   (setq org-export-content
  60         `((fonts ,(intern (concat "org-" suffix "-export-fonts")))
  61           (links ,(intern (concat "org-" suffix "-export-links")))
  62           (lists ,(intern (concat "org-" suffix "-export-lists")))
  63           (envs ,(intern (concat "org-" suffix "-export-quote-verse-center")))
  64           (tables ,(intern (concat "org-" suffix "-export-tables"))))))
  65
  66 ;;; Parsing functions:
  67
  68 (defun org-export-parse (&optional level)
  69   "Recursively parse the current buffer.
  70 If LEVEL is set, do the parsing at that level of sectioning.
  71 Return a nested list containing the structure of the parsed
  72 buffer and information about each section, including its
  73 content."
  74   (let (output eos)
  75     (save-excursion
  76       (goto-char (point-min))
  77       (while (re-search-forward org-complex-heading-regexp nil t)
  78         (let ((heading (match-string 4))
  79               (properties (org-entry-properties)))
  80           (save-restriction
  81             (narrow-to-region (if (looking-at "\n") (1+ (point)) (point))
  82                               (save-excursion
  83                                 (setq eos (org-end-of-subtree t t))))
  84             (setq output
  85                   (append output
  86                           (list
  87                            (list :level (or level 1)
  88                                  :heading heading
  89                                  :properties properties
  90                                  :content (org-export-get-entry-content)
  91                                  :subtree (org-export-parse
  92                                            (if level (1+ level) 2)))))))
  93           (goto-char (1- eos)))))
  94     output))
  95
  96 (defun org-export-get-entry-content ()
  97   "Extract the content of an entry.
  98 The content of a entry is the part before its first subtree or
  99 the end of the entry."
 100   (save-excursion
 101     (goto-char (point-min))
 102     ;; FIXME The following shouldn't be necessary since we are cleaning
 103     ;; up the buffer ith org-export-preprocess-string
 104     (while (or (looking-at org-property-drawer-re)
 105                (looking-at org-clock-drawer-re)
 106                (looking-at org-keyword-time-regexp))
 107       (move-beginning-of-line 1))
 108     (buffer-substring
 109      (point)
 110      (if (re-search-forward org-complex-heading-regexp nil t)
 111          (match-beginning 0) (point-max)))))
 112
 113 ;;; Rendering functions:
 114
 115 (defun org-export-render (&optional filter)
 116   "Render the current Org buffer and export it.
 117 First parse the buffer and return it as a nested list.  If FILTER
 118 is set, use it to filter this list (see `org-export-filter') then
 119 export the (filtered) list with `org-export-render-structure'."
 120   (setq org-export-properties
 121         (org-combine-plists (org-default-export-plist)
 122                             (org-infile-export-plist)))
 123   (let* (first-lines
 124          (bstring (buffer-string))
 125          (parsed-buffer
 126           (with-temp-buffer
 127             (org-mode)
 128             (insert (apply 'org-export-export-preprocess-string
 129                            bstring org-export-properties))
 130             (goto-char (point-min))
 131             (setq first-lines (org-export-get-entry-content))
 132             (org-export-parse))))
 133     (switch-to-buffer (get-buffer-create "*Org export*"))
 134     (erase-buffer)
 135     (funcall (cadr (assoc 'header org-export-structure)))
 136     (funcall (cadr (assoc 'first-lines org-export-structure)) first-lines)
 137     (org-export-render-structure parsed-buffer filter)
 138     (funcall (cadr (assoc 'footer org-export-structure)))))
 139
 140 (defun org-export-render-structure (parsed-buffer &optional filter)
 141   "Render PARSED-BUFFER.
 142 An optional argument FILTER specifies a filter to pass to the
 143 rendering engine."
 144   (mapc (lambda(s)
 145           (funcall (cadr (assoc 'section-beginning org-export-structure)) s)
 146           (funcall (cadr (assoc 'heading org-export-structure)) s)
 147           (insert (org-export-render-content s) "\n\n")
 148           (org-export-render-structure (plist-get s :subtree) filter)
 149           (funcall (cadr (assoc 'section-end org-export-structure)) s))
 150         (org-export-filter parsed-buffer filter)))
 151
 152 (defun org-export-render-content (section)
 153   "Render SECTION.
 154 SECTION is either a string or a property list containing
 155 informations (including content) for a section."
 156   (with-temp-buffer
 157     (insert (if (listp section) (plist-get section :content) section))
 158     (mapc (lambda(e)
 159             (goto-char (point-min))
 160             (funcall (cadr (assoc e org-export-content))))
 161           '(fonts tables lists envs links))
 162     (buffer-string)))
 163
 164 (defun org-export-filter (parsed-buffer filter)
 165   "Filter out PARSED-BUFFER with FILTER.
 166 PARSED-BUFFER is a nested list of sections and subsections, as
 167 produced by `org-export-parse'.  FILTER is an alist of rules to
 168 apply to PARSED-BUFFER.  For the syntax of a filter, please check
 169 the docstring of `org-export-latex-filter'."
 170   ;; FIXME where is org-export-latex-filter
 171   (delete
 172    nil
 173    (mapcar
 174     (lambda(s)
 175       (if (delete
 176            nil
 177            (mapcar
 178             (lambda(f)
 179               (let ((cnd (car f)) (re (cadr f)) prop-cnd)
 180                 (or (and (eq cnd 'heading)
 181                          (string-match re (plist-get s :heading)))
 182                     (and (eq cnd 'content)
 183                          (string-match re (plist-get s :content)))
 184                     (and (setq prop-cnd
 185                                (assoc cnd (plist-get s :properties)))
 186                          (string-match re (cadr prop-cnd))))))
 187             filter))
 188           nil  ;; return nil if the section is filtered out
 189         (progn (plist-put s :subtree
 190                           (org-export-filter (plist-get s :subtree) filter))
 191                s))) ;; return the section if it isn't filtered out
 192     parsed-buffer)))
 193
 194 ;; FIXME This function is a copy of `org-export-preprocess-string' which
 195 ;; should be rewritten for this export engine to work okay.
 196 (defun org-export-export-preprocess-string (string &rest parameters)
 197   "Cleanup STRING so that that the true exported has a more consistent source.
 198 This function takes STRING, which should be a buffer-string of an org-file
 199 to export.  It then creates a temporary buffer where it does its job.
 200 The result is then again returned as a string, and the exporter works
 201 on this string to produce the exported version."
 202   (interactive)
 203   (let* ((htmlp (plist-get parameters :for-html))
 204          (asciip (plist-get parameters :for-ascii))
 205          (latexp (plist-get parameters :for-LaTeX))
 206          (docbookp (plist-get parameters :for-docbook))
 207          (backend (cond (htmlp 'html)
 208                         (latexp 'latex)
 209                         (asciip 'ascii)
 210                         (docbookp 'docbook)))
 211          (archived-trees (plist-get parameters :archived-trees))
 212          (inhibit-read-only t)
 213          (drawers org-drawers)
 214          (outline-regexp "\\*+ ")
 215          target-alist rtn)
 216
 217     (setq org-export-target-aliases nil
 218           org-export-preferred-target-alist nil
 219           org-export-id-target-alist nil
 220           org-export-code-refs nil)
 221
 222     (with-current-buffer (get-buffer-create " org-mode-tmp")
 223       (erase-buffer)
 224       (insert string)
 225       (setq case-fold-search t)
 226
 227       (let ((inhibit-read-only t))
 228         (remove-text-properties (point-min) (point-max)
 229                                 '(read-only t)))
 230
 231       ;; Remove license-to-kill stuff
 232       ;; The caller marks some stuff for killing, stuff that has been
 233       ;; used to create the page title, for example.
 234       (org-export-kill-licensed-text)
 235
 236       (let ((org-inhibit-startup t)) (org-mode))
 237       (setq case-fold-search t)
 238       (org-install-letbind)
 239
 240       ;; Call the hook
 241       (run-hooks 'org-export-preprocess-hook)
 242
 243       ;; Process the macros
 244       (org-export-preprocess-apply-macros)
 245       (run-hooks 'org-export-preprocess-after-macros-hook)
 246
 247       (untabify (point-min) (point-max))
 248
 249       ;; Handle include files, and call a hook
 250       (org-export-handle-include-files-recurse)
 251       (run-hooks 'org-export-preprocess-after-include-files-hook)
 252
 253       ;; Get rid of archived trees
 254       (org-export-remove-archived-trees archived-trees)
 255
 256       ;; Remove comment environment and comment subtrees
 257       (org-export-remove-comment-blocks-and-subtrees)
 258
 259       ;; Get rid of excluded trees, and call a hook
 260       (org-export-handle-export-tags (plist-get parameters :select-tags)
 261                                      (plist-get parameters :exclude-tags))
 262       (run-hooks 'org-export-preprocess-after-tree-selection-hook)
 263
 264       ;; Mark end of lists
 265       (org-export-mark-list-ending backend)
 266
 267       ;; Handle source code snippets
 268       ;; (org-export-export-replace-src-segments-and-examples backend)
 269
 270       ;; Protect short examples marked by a leading colon
 271       (org-export-protect-colon-examples)
 272
 273       ;; Normalize footnotes
 274       (when (plist-get parameters :footnotes)
 275         (org-footnote-normalize nil t))
 276
 277       ;; Find all headings and compute the targets for them
 278       (setq target-alist (org-export-define-heading-targets target-alist))
 279
 280       (run-hooks 'org-export-preprocess-after-headline-targets-hook)
 281
 282       ;; Find HTML special classes for headlines
 283       (org-export-remember-html-container-classes)
 284
 285       ;; Get rid of drawers
 286       (org-export-remove-or-extract-drawers
 287        drawers (plist-get parameters :drawers) backend)
 288
 289       ;; Get the correct stuff before the first headline
 290       (when (plist-get parameters :skip-before-1st-heading)
 291         (goto-char (point-min))
 292         (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
 293           (delete-region (point-min) (match-beginning 0))
 294           (goto-char (point-min))
 295           (insert "\n")))
 296       (when (plist-get parameters :text)
 297         (goto-char (point-min))
 298         (insert (plist-get parameters :text) "\n"))
 299
 300       ;; Remove todo-keywords before exporting, if the user has requested so
 301       (org-export-remove-headline-metadata parameters)
 302
 303       ;; Find targets in comments and move them out of comments,
 304       ;; but mark them as targets that should be invisible
 305       (setq target-alist (org-export-handle-invisible-targets target-alist))
 306
 307       ;; Select and protect backend specific stuff, throw away stuff
 308       ;; that is specific for other backends
 309       (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook)
 310       (org-export-select-backend-specific-text backend)
 311
 312       ;; Protect quoted subtrees
 313       (org-export-protect-quoted-subtrees)
 314
 315       ;; Remove clock lines
 316       (org-export-remove-clock-lines)
 317
 318       ;; Protect verbatim elements
 319       (org-export-protect-verbatim)
 320
 321       ;; Blockquotes, verse, and center
 322       (org-export-mark-blockquote-verse-center)
 323       (run-hooks 'org-export-preprocess-after-blockquote-hook)
 324
 325       ;; Remove timestamps, if the user has requested so
 326       (unless (plist-get parameters :timestamps)
 327         (org-export-remove-timestamps))
 328
 329       ;; Attach captions to the correct object
 330       ;; (setq target-alist (org-export-attach-captions-and-attributes
 331       ;;                          backend target-alist))
 332
 333       ;; Find matches for radio targets and turn them into internal links
 334       (org-export-mark-radio-links)
 335       (run-hooks 'org-export-preprocess-after-radio-targets-hook)
 336
 337       ;; Find all links that contain a newline and put them into a single line
 338       (org-export-concatenate-multiline-links)
 339
 340       ;; Normalize links: Convert angle and plain links into bracket links
 341       ;; and expand link abbreviations
 342       (run-hooks 'org-export-preprocess-before-normalizing-links-hook)
 343       (org-export-normalize-links)
 344
 345       ;; Find all internal links.  If they have a fuzzy match (i.e. not
 346       ;; a *dedicated* target match, let the link  point to the
 347       ;; corresponding section.
 348       (org-export-target-internal-links target-alist)
 349
 350       ;; Find multiline emphasis and put them into single line
 351       (when (plist-get parameters :emph-multiline)
 352         (org-export-concatenate-multiline-emphasis))
 353
 354       ;; Remove special table lines
 355       (when org-export-table-remove-special-lines
 356         (org-export-remove-special-table-lines))
 357
 358       ;; Another hook
 359       (run-hooks 'org-export-preprocess-before-backend-specifics-hook)
 360
 361       ;; LaTeX-specific preprocessing
 362       (when latexp
 363         (require 'org-latex nil)
 364         (org-export-latex-preprocess parameters))
 365
 366       ;; ASCII-specific preprocessing
 367       (when asciip
 368         (org-export-ascii-preprocess parameters))
 369
 370       ;; HTML-specific preprocessing
 371       (when htmlp
 372         (org-export-html-preprocess parameters))
 373
 374       ;; DocBook-specific preprocessing
 375       (when docbookp
 376         (require 'org-docbook nil)
 377         (org-export-docbook-preprocess parameters))
 378
 379       ;; Remove or replace comments
 380       (org-export-handle-comments (plist-get parameters :comments))
 381
 382       ;; Remove #+TBLFM and #+TBLNAME lines
 383       (org-export-handle-table-metalines)
 384
 385       ;; Run the final hook
 386       (run-hooks 'org-export-preprocess-final-hook)
 387
 388       (setq rtn (buffer-string))
 389       (kill-buffer " org-mode-tmp"))
 390     rtn))
 391
 392 (provide 'org-export)
 393
 394 ;;;  User Options, Variables
 395
 396 ;;; org-export.el ends here