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 ;;; Code:
  38
  39 (eval-when-compile
  40   (require 'cl))
  41
  42 ;;; Preparation functions:
  43
  44 ;; Currently needed for `org-export-preprocess-string'
  45 (require 'org-exp)
  46
  47 (defvar org-export-structure nil)
  48 (defvar org-export-content nil)
  49 (defvar org-export-properties nil)
  50
  51 (defun org-export-set-backend (suffix)
  52   "Set the backend functions names from SUFFIX."
  53   (setq org-export-structure
  54         `((header ,(intern (concat "org-" suffix "-export-header")))
  55           (first-lines ,(intern (concat "org-" suffix "-export-first-lines")))
  56           (section-beginning ,(intern (concat "org-" suffix "-export-section-beginning")))
  57           (heading ,(intern (concat "org-" suffix "-export-heading")))
  58           (section-end ,(intern (concat "org-" suffix "-export-section-end")))
  59           (footer ,(intern (concat "org-" suffix "-export-footer")))))
  60   (setq org-export-content
  61         `((fonts ,(intern (concat "org-" suffix "-export-fonts")))
  62           (links ,(intern (concat "org-" suffix "-export-links")))
  63           (lists ,(intern (concat "org-" suffix "-export-lists")))
  64           (envs ,(intern (concat "org-" suffix "-export-quote-verse-center")))
  65           (tables ,(intern (concat "org-" suffix "-export-tables"))))))
  66
  67 ;;; Parsing functions:
  68
  69 (defun org-export-parse (&optional level)
  70   "Recursively parse the current buffer.
  71 If LEVEL is set, do the parsing at that level of sectioning.
  72 Return a nested list containing the structure of the parsed
  73 buffer and information about each section, including its
  74 content."
  75   (let (output eos)
  76     (save-excursion
  77       (goto-char (point-min))
  78       (while (re-search-forward org-complex-heading-regexp nil t)
  79         (let ((heading (match-string 4))
  80               (properties (org-entry-properties)))
  81           (save-restriction
  82             (narrow-to-region (if (looking-at "\n") (1+ (point)) (point))
  83                               (save-excursion
  84                                 (setq eos (org-end-of-subtree t t))))
  85             (setq output
  86                   (append output
  87                           (list
  88                            (list :level (or level 1)
  89                                  :heading heading
  90                                  :properties properties
  91                                  :content (org-export-get-entry-content)
  92                                  :subtree (org-export-parse
  93                                            (if level (1+ level) 2)))))))
  94           (goto-char (1- eos)))))
  95     output))
  96
  97 (defun org-export-get-entry-content ()
  98   "Extract the content of an entry.
  99 The content of a entry is the part before its first subtree or
 100 the end of the entry."
 101   (save-excursion
 102     (goto-char (point-min))
 103     ;; FIXME The following shouldn't be necessary since we are cleaning
 104     ;; up the buffer ith org-export-preprocess-string
 105     (while (or (looking-at org-property-drawer-re)
 106                (looking-at org-clock-drawer-re)
 107                (looking-at org-keyword-time-regexp))
 108       (move-beginning-of-line 1))
 109     (buffer-substring
 110      (point)
 111      (if (re-search-forward org-complex-heading-regexp nil t)
 112          (match-beginning 0) (point-max)))))
 113
 114 ;;; Rendering functions:
 115
 116 (defun org-export-render (&optional filter)
 117   "Render the current Org buffer and export it.
 118 First parse the buffer and return it as a nested list.  If FILTER
 119 is set, use it to filter this list (see `org-export-filter') then
 120 export the (filtered) list with `org-export-render-structure'."
 121   (setq org-export-properties
 122         (org-combine-plists (org-default-export-plist)
 123                             (org-infile-export-plist)))
 124   (let* (first-lines
 125          (bstring (buffer-string))
 126          (parsed-buffer
 127           (with-temp-buffer
 128             (org-mode)
 129             (insert (apply 'org-export-preprocess-string
 130                            bstring org-export-properties))
 131             (goto-char (point-min))
 132             (setq first-lines (org-export-get-entry-content))
 133             (org-export-parse))))
 134     (switch-to-buffer (get-buffer-create "*Org export*"))
 135     (erase-buffer)
 136     (funcall (cadr (assoc 'header org-export-structure)))
 137     (funcall (cadr (assoc 'first-lines org-export-structure)) first-lines)
 138     (org-export-render-structure parsed-buffer filter)
 139     (funcall (cadr (assoc 'footer org-export-structure)))))
 140
 141 (defun org-export-render-structure (parsed-buffer &optional filter)
 142   "Render PARSED-BUFFER.
 143 An optional argument FILTER specifies a filter to pass to the
 144 rendering engine."
 145   (mapc (lambda(s)
 146           (funcall (cadr (assoc 'section-beginning org-export-structure)) s)
 147           (funcall (cadr (assoc 'heading org-export-structure)) s)
 148           (insert (org-export-render-content s) "\n\n")
 149           (org-export-render-structure (plist-get s :subtree) filter)
 150           (funcall (cadr (assoc 'section-end org-export-structure)) s))
 151         (org-export-filter parsed-buffer filter)))
 152
 153 (defun org-export-render-content (section)
 154   "Render SECTION.
 155 SECTION is either a string or a property list containing
 156 informations (including content) for a section."
 157   (with-temp-buffer
 158     (insert (if (listp section) (plist-get section :content) section))
 159     (mapc (lambda(e)
 160             (goto-char (point-min))
 161             (funcall (cadr (assoc e org-export-content))))
 162           '(fonts tables lists envs links))
 163     (buffer-string)))
 164
 165 (defun org-export-filter (parsed-buffer filter)
 166   "Filter out PARSED-BUFFER with FILTER.
 167 PARSED-BUFFER is a nested list of sections and subsections, as
 168 produced by `org-export-parse'.  FILTER is an alist of rules to
 169 apply to PARSED-BUFFER.  For the syntax of a filter, please check
 170 the docstring of `org-export-latex-filter'."
 171   ;; FIXME where is org-export-latex-filter
 172   (delete
 173    nil
 174    (mapcar
 175     (lambda(s)
 176       (if (delete
 177            nil
 178            (mapcar
 179             (lambda(f)
 180               (let ((cnd (car f)) (re (cadr f)) prop-cnd)
 181                 (or (and (eq cnd 'heading)
 182                          (string-match re (plist-get s :heading)))
 183                     (and (eq cnd 'content)
 184                          (string-match re (plist-get s :content)))
 185                     (and (setq prop-cnd
 186                                (assoc cnd (plist-get s :properties)))
 187                          (string-match re (cadr prop-cnd))))))
 188             filter))
 189           nil  ;; return nil if the section is filtered out
 190         (progn (plist-put s :subtree
 191                           (org-export-filter (plist-get s :subtree) filter))
 192                s))) ;; return the section if it isn't filtered out
 193     parsed-buffer)))
 194
 195 (provide 'org-export)
 196
 197 ;;;  User Options, Variables
 198
 199 ;;; org-export.el ends here