diff --git a/EXPERIMENTAL/org-export.el b/EXPERIMENTAL/org-export.el index 2261da3d4..f04ffaf2d 100644 --- a/EXPERIMENTAL/org-export.el +++ b/EXPERIMENTAL/org-export.el @@ -1,14 +1,14 @@ ;;; org-export.el --- Export engine for Org ;; -;; Copyright 2008 Bastien Guerry +;; Copyright 2008 2010 Bastien Guerry ;; ;; Emacs Lisp Archive Entry ;; Filename: org-export.el -;; Version: 0.1a +;; Version: 0.3 ;; Author: Bastien ;; Maintainer: Bastien -;; Keywords: -;; Description: +;; Keywords: +;; Description: ;; URL: [Not distributed yet] ;; ;; This program is free software; you can redistribute it and/or modify @@ -27,23 +27,50 @@ ;; ;;; Commentary: ;; -;; This is the export engine for Org. +;; org-export.el implements a new experimental export engine for Org. ;; ;; Put this file into your load-path and the following into your ~/.emacs: ;; (require 'org-export) ;; +;;; Todo: +;; +;; Rewrite `org-export-export-preprocess-string'. +;; ;;; Code: (eval-when-compile (require 'cl)) +;;; Preparation functions: + +(defvar org-export-structure nil) +(defvar org-export-content nil) +(defvar org-export-properties nil) + +(defun org-export-set-backend (suffix) + "Set the backend functions names from SUFFIX." + (setq org-export-structure + `((header ,(intern (concat "org-" suffix "-export-header"))) + (first-lines ,(intern (concat "org-" suffix "-export-first-lines"))) + (section-beginning ,(intern (concat "org-" suffix "-export-section-beginning"))) + (heading ,(intern (concat "org-" suffix "-export-heading"))) + (section-end ,(intern (concat "org-" suffix "-export-section-end"))) + (footer ,(intern (concat "org-" suffix "-export-footer"))))) + (setq org-export-content + `((fonts ,(intern (concat "org-" suffix "-export-fonts"))) + (links ,(intern (concat "org-" suffix "-export-links"))) + (lists ,(intern (concat "org-" suffix "-export-lists"))) + (envs ,(intern (concat "org-" suffix "-export-quote-verse-center"))) + (tables ,(intern (concat "org-" suffix "-export-tables")))))) + ;;; Parsing functions: (defun org-export-parse (&optional level) - "Parse the current buffer. -Return a nested list reflecting the sectioning structure of the -file and containing all information about each section, including -its content." + "Recursively parse the current buffer. +If LEVEL is set, do the parsing at that level of sectioning. +Return a nested list containing the structure of the parsed +buffer and information about each section, including its +content." (let (output eos) (save-excursion (goto-char (point-min)) @@ -52,116 +79,101 @@ its content." (properties (org-entry-properties))) (save-restriction (narrow-to-region (if (looking-at "\n") (1+ (point)) (point)) - (save-excursion + (save-excursion (setq eos (org-end-of-subtree t t)))) (setq output (append output - (list + (list (list :level (or level 1) :heading heading :properties properties - :content (org-export-parse-clean-content-string - (org-export-parse-content)) - :subtree (org-export-parse + :content (org-export-get-entry-content) + :subtree (org-export-parse (if level (1+ level) 2))))))) (goto-char (1- eos))))) output)) -(defun org-export-parse-content () - "Extract the content of a section. -The content of a section is the part before a subtree." +(defun org-export-get-entry-content () + "Extract the content of an entry. +The content of a entry is the part before its first subtree or +the end of the entry." (save-excursion (goto-char (point-min)) + ;; FIXME The following shouldn't be necessary since we are cleaning + ;; up the buffer ith org-export-preprocess-string + (while (or (looking-at org-property-drawer-re) + (looking-at org-clock-drawer-re) + (looking-at org-keyword-time-regexp)) + (move-beginning-of-line 1)) (buffer-substring (point) (if (re-search-forward org-complex-heading-regexp nil t) (match-beginning 0) (point-max))))) -(defun org-export-parse-clean-content-string (s) - "From the content string S, remove stuff also captured by get-properties. -So this will remove the clock drawer, the property drawer, and the lines -with planning info (DEADLINE, SCHEDULED, CLOSED)." - (if (string-match org-property-drawer-re s) - (setq s (replace-match "" t t s))) - (if (string-match org-clock-drawer-re s) - (setq s (replace-match "" t t s))) - (while (string-match (concat org-keyword-time-regexp ".*\n?") s) - (setq s (replace-match "" t t s))) - s) - ;;; Rendering functions: -(defun org-export-buffer (filter struct-backend content-backend) - "Render the current buffer. -It first parses the current buffer into a list. Then it filters -this list with FILTER. Finally it uses STRUCT-BACKEND and -CONTENT-BACKEND to render the structure of the buffer and the -content of each section." - (save-excursion - (let* ((props (org-combine-plists - (org-default-export-plist) - (org-infile-export-plist))) - (first-lines (org-export-parse-content)) - (parsed-buffer (org-export-parse))) - (switch-to-buffer (get-buffer-create "*Org export*")) - (erase-buffer) - (funcall (cdr (assoc 'header struct-backend)) props) - (funcall (cdr (assoc 'first-lines struct-backend)) - first-lines props) - (org-export-render-structure parsed-buffer props filter - struct-backend content-backend) - (funcall (cdr (assoc 'footer struct-backend)) props)))) +(defun org-export-render (&optional filter) + "Render the current Org buffer and export it. +First parse the buffer and return it as a nested list. If FILTER +is set, use it to filter this list (see `org-export-filter') then +export the (filtered) list with `org-export-render-structure'." + (setq org-export-properties + (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (let* (first-lines + (bstring (buffer-string)) + (parsed-buffer + (with-temp-buffer + (org-mode) + (insert (apply 'org-export-export-preprocess-string + bstring org-export-properties)) + (goto-char (point-min)) + (setq first-lines (org-export-get-entry-content)) + (org-export-parse)))) + (switch-to-buffer (get-buffer-create "*Org export*")) + (erase-buffer) + (funcall (cadr (assoc 'header org-export-structure))) + (funcall (cadr (assoc 'first-lines org-export-structure)) first-lines) + (org-export-render-structure parsed-buffer filter) + (funcall (cadr (assoc 'footer org-export-structure))))) -(defun org-export-render-structure - (parsed-buffer props filter struct-backend content-backend) +(defun org-export-render-structure (parsed-buffer &optional filter) "Render PARSED-BUFFER. -The optional argument FILTER specifies a filter to pass to the +An optional argument FILTER specifies a filter to pass to the rendering engine." (mapc (lambda(s) - (funcall (cdr (assoc 'section-beginning struct-backend)) s) - (funcall (cdr (assoc 'heading struct-backend)) s) - (insert (org-export-render-content s props content-backend) "\n\n") - (org-export-render-structure (plist-get s :subtree) props - filter struct-backend content-backend) - (funcall (cdr (assoc 'section-end struct-backend)) s)) + (funcall (cadr (assoc 'section-beginning org-export-structure)) s) + (funcall (cadr (assoc 'heading org-export-structure)) s) + (insert (org-export-render-content s) "\n\n") + (org-export-render-structure (plist-get s :subtree) filter) + (funcall (cadr (assoc 'section-end org-export-structure)) s)) (org-export-filter parsed-buffer filter))) -(defun org-export-render-content (section props content-backend) - "Render SECTION with PROPS. SECTION is the property list -defining the information for the section. PROPS is the property -list defining information for the current export. -CONTENT-BACKEND is an association list defining possible -exporting directive the content of this section." +(defun org-export-render-content (section) + "Render SECTION. +SECTION is either a string or a property list containing +informations (including content) for a section." (with-temp-buffer - (insert (plist-get section :content)) - (if (not (plist-get props :with-comment)) - (funcall (cdr (assoc 'comment content-backend)))) + (insert (if (listp section) (plist-get section :content) section)) + (mapc (lambda(e) + (goto-char (point-min)) + (funcall (cadr (assoc e org-export-content)))) + '(fonts tables lists envs links)) (buffer-string))) -(defun org-export-strip-drawer () - "Strip DRAWERS in the current buffer. -Stripped drawers are those matched by `org-drawer-regexp'." - (save-excursion - (while (re-search-forward org-drawer-regexp nil t) - (let ((beg (match-beginning 0)) - (end (and (search-forward ":END:" nil t) - (match-end 0)))) - (delete-region beg end))))) - -;;; Filtering functions: - (defun org-export-filter (parsed-buffer filter) "Filter out PARSED-BUFFER with FILTER. -PARSED-BUFFER is a nested list a sections and subsections, as +PARSED-BUFFER is a nested list of sections and subsections, as produced by `org-export-parse'. FILTER is an alist of rules to apply to PARSED-BUFFER. For the syntax of a filter, please check the docstring of `org-export-latex-filter'." - (delete - nil - (mapcar + ;; FIXME where is org-export-latex-filter + (delete + nil + (mapcar (lambda(s) (if (delete - nil + nil (mapcar (lambda(f) (let ((cnd (car f)) (re (cadr f)) prop-cnd) @@ -169,16 +181,214 @@ the docstring of `org-export-latex-filter'." (string-match re (plist-get s :heading))) (and (eq cnd 'content) (string-match re (plist-get s :content))) - (and (setq prop-cnd + (and (setq prop-cnd (assoc cnd (plist-get s :properties))) (string-match re (cadr prop-cnd)))))) filter)) nil ;; return nil if the section is filtered out - (progn (plist-put s :subtree + (progn (plist-put s :subtree (org-export-filter (plist-get s :subtree) filter)) s))) ;; return the section if it isn't filtered out parsed-buffer))) +;; FIXME This function is a copy of `org-export-preprocess-string' which +;; should be rewritten for this export engine to work okay. +(defun org-export-export-preprocess-string (string &rest parameters) + "Cleanup STRING so that that the true exported has a more consistent source. +This function takes STRING, which should be a buffer-string of an org-file +to export. It then creates a temporary buffer where it does its job. +The result is then again returned as a string, and the exporter works +on this string to produce the exported version." + (interactive) + (let* ((htmlp (plist-get parameters :for-html)) + (asciip (plist-get parameters :for-ascii)) + (latexp (plist-get parameters :for-LaTeX)) + (docbookp (plist-get parameters :for-docbook)) + (backend (cond (htmlp 'html) + (latexp 'latex) + (asciip 'ascii) + (docbookp 'docbook))) + (archived-trees (plist-get parameters :archived-trees)) + (inhibit-read-only t) + (drawers org-drawers) + (outline-regexp "\\*+ ") + target-alist rtn) + + (setq org-export-target-aliases nil + org-export-preferred-target-alist nil + org-export-id-target-alist nil + org-export-code-refs nil) + + (with-current-buffer (get-buffer-create " org-mode-tmp") + (erase-buffer) + (insert string) + (setq case-fold-search t) + + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(read-only t))) + + ;; Remove license-to-kill stuff + ;; The caller marks some stuff for killing, stuff that has been + ;; used to create the page title, for example. + (org-export-kill-licensed-text) + + (let ((org-inhibit-startup t)) (org-mode)) + (setq case-fold-search t) + (org-install-letbind) + + ;; Call the hook + (run-hooks 'org-export-preprocess-hook) + + ;; Process the macros + (org-export-preprocess-apply-macros) + (run-hooks 'org-export-preprocess-after-macros-hook) + + (untabify (point-min) (point-max)) + + ;; Handle include files, and call a hook + (org-export-handle-include-files-recurse) + (run-hooks 'org-export-preprocess-after-include-files-hook) + + ;; Get rid of archived trees + (org-export-remove-archived-trees archived-trees) + + ;; Remove comment environment and comment subtrees + (org-export-remove-comment-blocks-and-subtrees) + + ;; Get rid of excluded trees, and call a hook + (org-export-handle-export-tags (plist-get parameters :select-tags) + (plist-get parameters :exclude-tags)) + (run-hooks 'org-export-preprocess-after-tree-selection-hook) + + ;; Mark end of lists + (org-export-mark-list-ending backend) + + ;; Handle source code snippets + ;; (org-export-export-replace-src-segments-and-examples backend) + + ;; Protect short examples marked by a leading colon + (org-export-protect-colon-examples) + + ;; Normalize footnotes + (when (plist-get parameters :footnotes) + (org-footnote-normalize nil t)) + + ;; Find all headings and compute the targets for them + (setq target-alist (org-export-define-heading-targets target-alist)) + + (run-hooks 'org-export-preprocess-after-headline-targets-hook) + + ;; Find HTML special classes for headlines + (org-export-remember-html-container-classes) + + ;; Get rid of drawers + (org-export-remove-or-extract-drawers + drawers (plist-get parameters :drawers) backend) + + ;; Get the correct stuff before the first headline + (when (plist-get parameters :skip-before-1st-heading) + (goto-char (point-min)) + (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t) + (delete-region (point-min) (match-beginning 0)) + (goto-char (point-min)) + (insert "\n"))) + (when (plist-get parameters :text) + (goto-char (point-min)) + (insert (plist-get parameters :text) "\n")) + + ;; Remove todo-keywords before exporting, if the user has requested so + (org-export-remove-headline-metadata parameters) + + ;; Find targets in comments and move them out of comments, + ;; but mark them as targets that should be invisible + (setq target-alist (org-export-handle-invisible-targets target-alist)) + + ;; Select and protect backend specific stuff, throw away stuff + ;; that is specific for other backends + (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook) + (org-export-select-backend-specific-text backend) + + ;; Protect quoted subtrees + (org-export-protect-quoted-subtrees) + + ;; Remove clock lines + (org-export-remove-clock-lines) + + ;; Protect verbatim elements + (org-export-protect-verbatim) + + ;; Blockquotes, verse, and center + (org-export-mark-blockquote-verse-center) + (run-hooks 'org-export-preprocess-after-blockquote-hook) + + ;; Remove timestamps, if the user has requested so + (unless (plist-get parameters :timestamps) + (org-export-remove-timestamps)) + + ;; Attach captions to the correct object + ;; (setq target-alist (org-export-attach-captions-and-attributes + ;; backend target-alist)) + + ;; Find matches for radio targets and turn them into internal links + (org-export-mark-radio-links) + (run-hooks 'org-export-preprocess-after-radio-targets-hook) + + ;; Find all links that contain a newline and put them into a single line + (org-export-concatenate-multiline-links) + + ;; Normalize links: Convert angle and plain links into bracket links + ;; and expand link abbreviations + (run-hooks 'org-export-preprocess-before-normalizing-links-hook) + (org-export-normalize-links) + + ;; Find all internal links. If they have a fuzzy match (i.e. not + ;; a *dedicated* target match, let the link point to the + ;; corresponding section. + (org-export-target-internal-links target-alist) + + ;; Find multiline emphasis and put them into single line + (when (plist-get parameters :emph-multiline) + (org-export-concatenate-multiline-emphasis)) + + ;; Remove special table lines + (when org-export-table-remove-special-lines + (org-export-remove-special-table-lines)) + + ;; Another hook + (run-hooks 'org-export-preprocess-before-backend-specifics-hook) + + ;; LaTeX-specific preprocessing + (when latexp + (require 'org-latex nil) + (org-export-latex-preprocess parameters)) + + ;; ASCII-specific preprocessing + (when asciip + (org-export-ascii-preprocess parameters)) + + ;; HTML-specific preprocessing + (when htmlp + (org-export-html-preprocess parameters)) + + ;; DocBook-specific preprocessing + (when docbookp + (require 'org-docbook nil) + (org-export-docbook-preprocess parameters)) + + ;; Remove or replace comments + (org-export-handle-comments (plist-get parameters :comments)) + + ;; Remove #+TBLFM and #+TBLNAME lines + (org-export-handle-table-metalines) + + ;; Run the final hook + (run-hooks 'org-export-preprocess-final-hook) + + (setq rtn (buffer-string)) + (kill-buffer " org-mode-tmp")) + rtn)) + (provide 'org-export) ;;; User Options, Variables diff --git a/lisp/org.el b/lisp/org.el index 1099ab415..0e933e20b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4755,7 +4755,7 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi")) + "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil