From e32a45ed36d6000db4b39171149072d11b77af72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Sun, 13 Jul 2014 13:35:27 +0200 Subject: Imported Upstream version 8.0.7 --- contrib/lisp/org-export-generic.el | 1504 ------------------------------------ 1 file changed, 1504 deletions(-) delete mode 100644 contrib/lisp/org-export-generic.el (limited to 'contrib/lisp/org-export-generic.el') diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el deleted file mode 100644 index 4de38c7..0000000 --- a/contrib/lisp/org-export-generic.el +++ /dev/null @@ -1,1504 +0,0 @@ -;; org-export-generic.el --- Export frameworg with custom backends - -;; Copyright (C) 2009-2012 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: outlines, hypermedia, calendar, wp, export -;; Homepage: http://orgmode.org -;; Version: 6.25trans -;; Acks: Much of this code was stolen form the ascii export from Carsten -;; -;; This file is not yet part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;; -;; ---------------------------------------------------------------------- -;; -;; OVERVIEW -;; -;; org-export-generic is basically a simple translation system that -;; knows how to parse at least most of a .org buffer and then add -;; various formatting prefixes before and after each section type. It -;; does this by examining a property list stored in org-generic-alist. -;; You can dynamically add propety lists of your own using the -;; org-set-generic-type function: -;; -;; (org-set-generic-type -;; "really-basic-text" -;; '(:file-suffix ".txt" -;; :key-binding ?R -;; -;; :title-format "=== %s ===\n" -;; :body-header-section-numbers t -;; :body-header-section-number-format "%s) " -;; :body-section-header-prefix "\n" -;; :body-section-header-suffix "\n" -;; :body-line-format " %s\n" -;; :body-line-wrap 75 -;; )) -;; -;; Note: Upper case key-bindings are reserved for your use. Lower -;; case key bindings may conflict with future export-generic -;; publications. -;; -;; Then run org-export (ctrl-c ctrl-e) and select generic or run -;; org-export-generic. You'll then be prompted with a list of export -;; types to choose from which will include your new type assigned to -;; the key "r". -;; -;; ---------------------------------------------------------------------- -;; -;; TODO (non-ordered) -;; * handle function references -;; * handle other types of multi-complex-listy-things to do -;; ideas: (t ?- "%s" ?-) -;; * handle indent specifiers better -;; ideas: (4 ?\ "%s") -;; * need flag to remove indents from body text -;; * handle links -;; * handle internationalization strings better -;; * date/author/etc needs improvment (internationalization too) -;; * allow specifying of section ordering -;; ideas: :ordering ("header" "toc" "body" "footer") -;; ^ matches current hard coded ordering -;; * err, actually *do* a footer -;; * deal with usage of org globals -;; *** should we even consider them, or let the per-section specifiers do it -;; *** answer: remove; mostly removed now -;; * deal with interactive support for picking a export specifier label -;; * char specifiers that need extra length because of formatting -;; idea: (?- 4) for 4-longer -;; * centering specifier -;; idea: ('center " -- %s -- ") -;; * remove more of the unneeded export-to-ascii copy code -;; * tags -;; *** supported now, but need separate format per tag -;; *** allow different open/closing prefixes -;; * properties -;; * drawers -;; * Escape camel-case for wiki exporters. -;; * Adjust to depth limits on headers --- need to roll-over from headers -;; to lists, as per other exporters -;; * optmization (many plist extracts should be in let vars) -;; * define defcustom spec for the specifier list -;; * fonts: at least monospace is not handled at all here. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -(require 'org-exp) -(require 'assoc) -(eval-when-compile (require 'cl)) - -(defgroup org-export-generic nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-generic-links-to-notes t - "Non-nil means convert links to notes before the next headline. -When nil, the link will be exported in place. If the line becomes long -in this way, it will be wrapped." - :group 'org-export-generic - :type 'boolean) - - -(defvar org-generic-current-indentation nil) ; For communication - -(defvar org-generic-alist - '( - ;; - ;; generic DEMO exporter - ;; - ;; (this tries to use every specifier for demo purposes) - ;; - ("demo" - :file-suffix ".txt" - :key-binding ?d - - :header-prefix "
\n" - :header-suffix "
\n" - - :author-export t - :tags-export t - - :drawers-export t - - - :title-prefix ?= - :title-format "

%s

\n" - :title-suffix ?= - - :date-export t - :date-prefix "" - :date-format "
Date: %s
" - :date-suffix "\n\n" - - :toc-export t - :toc-header-prefix "\n" - :toc-header-format "__%s__\n" - :toc-header-suffix "\n" - - :toc-prefix "\n" - :toc-suffix "\n" - - :toc-section-numbers t - :toc-section-number-format "\#(%s) " - :toc-format "--%s--" - :toc-format-with-todo "!!%s!!\n" - :toc-indent-char ?\ - :toc-indent-depth 4 - - :toc-tags-export t - :toc-tags-prefix " " - :toc-tags-format "*%s*" - :toc-tags-suffix "\n" - :toc-tags-none-string "\n" - - :body-header-section-numbers 3 ; t = all, nil = none - - ; lists indicate different things per level - ; list contents or straight value can either be a - ; ?x char reference for printing strings that match the header len - ; "" string to print directly - :body-section-header-prefix ("

" "

" "

" - "

" "

" "
") - :body-section-header-format "%s" - :body-section-header-suffix ("
\n" "\n" "\n" - "\n" "\n" "\n") - - :timestamps-export t - :priorities-export t - :todo-keywords-export t - - :body-tags-export t - :body-tags-prefix " " - :body-tags-suffix "\n" - - ; section prefixes/suffixes can be direct strings or lists as well - :body-section-prefix "\n" - :body-section-suffix "\n" - ; :body-section-prefix ("\n" "\n" "\n") - ; :body-section-suffix ("\n" "\n" "\n") - - - ; if preformated text should be included (eg, : prefixed) - :body-line-export-preformated t - :body-line-fixed-prefix "
\n"
-     :body-line-fixed-suffix       "\n
\n" - :body-line-fixed-format "%s\n" - - - :body-list-prefix "\n" - :body-list-suffix "\n" - :body-list-format "
  • %s
    • \n" - - :body-number-list-prefix "
      \n" - :body-number-list-suffix "
    \n" - :body-number-list-format "
  • %s
    • \n" - :body-number-list-leave-number t - - :body-list-checkbox-todo "" - :body-list-checkbox-todo-end "" - :body-list-checkbox-done "" - :body-list-checkbox-done-end "" - :body-list-checkbox-half "" - :body-list-checkbox-half-end "" - - - - - ; other body lines - :body-line-format "%s" - :body-line-wrap 60 ; wrap at 60 chars - - ; print above and below all body parts - :body-text-prefix "

    \n" - :body-text-suffix "

    \n" - - ) - - ;; - ;; ascii exporter - ;; - ;; (close to the original ascii specifier) - ;; - ("ascii" - :file-suffix ".txt" - :key-binding ?a - - :header-prefix "" - :header-suffix "" - - :title-prefix ?= - :title-format "%s\n" - :title-suffix ?= - - :date-export t - :date-prefix "" - :date-format "Date: %s\n" - :date-suffix "" - - :toc-header-prefix "" - :toc-header-format "%s\n" - :toc-header-suffix ?= - - :toc-export t - :toc-section-numbers t - :toc-section-number-format "%s " - :toc-format "%s\n" - :toc-format-with-todo "%s (*)\n" - :toc-indent-char ?\ - :toc-indent-depth 4 - - :body-header-section-numbers 3 - :body-section-prefix "\n" - - ; :body-section-header-prefix "\n" - ; :body-section-header-format "%s\n" - ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-) - - :body-section-header-prefix ("" "" "" "* " " + " " - ") - :body-section-header-format "%s\n" - :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n") - - ; :body-section-marker-prefix "" - ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-) - ; :body-section-marker-suffix "\n" - - :body-line-export-preformated t - :body-line-format "%s\n" - :body-line-wrap 75 - - ; :body-text-prefix "\n" - ; :body-text-suffix "\n" - - - :body-bullet-list-prefix (?* ?+ ?-) - ; :body-bullet-list-suffix (?* ?+ ?-) - ) - - ;; - ;; wikipedia - ;; - ("wikipedia" - :file-suffix ".txt" - :key-binding ?w - - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("= " "== " "=== " - "==== " "===== " "====== ") - :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" - " ====\n\n" " =====\n\n" " ======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") - ) - ;; - ;; mediawiki - ;; - ("mediawiki" - :file-suffix ".txt" - :key-binding ?m - - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("= " "== " "=== " - "==== " "===== " "====== ") - :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" - " ====\n\n" " =====\n\n" " ======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") - :body-list-checkbox-todo "☐ " - :body-list-checkbox-done "☒ " - :body-table-start "{|" - :body-table-end "|}" - :body-table-cell-start "|" - :body-table-cell-end "\n" - :body-table-last-cell-end "|-" - :body-table-hline-start "" - - - ) - ;; - ;; internet-draft .xml for xml2rfc exporter - ;; - ("ietfid" - ;; this tries to use every specifier for demo purposes - :file-suffix ".xml" - :key-binding ?i - - :title-prefix " - - - - - - - - - -" - :title-format "\n%s\n\n" - :title-suffix " - Comany, Inc.. -
    - - - - - - - - - -
    -     - - Operations and Management - FIXME -\n" - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - - :body-section-header-format "
    \n" - :body-section-suffix "
    \n" - - ; if preformated text should be included (eg, : prefixed) - :body-line-export-preformated t - :body-line-fixed-prefix "
    \n\n" - :body-line-fixed-suffix "\n\n
    \n" - - ; other body lines - :body-line-format "%s" - :body-line-wrap 75 - - ; print above and below all body parts - :body-text-prefix "\n" - :body-text-suffix "\n" - - :body-list-prefix "\n" - :body-list-suffix "\n" - :body-list-format "%s\n" - - ) - ("trac-wiki" - :file-suffix ".txt" - :key-binding ?T - - ;; lifted from wikipedia exporter - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix (" == " " === " " ==== " - " ===== " ) - :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n" - " =====\n\n" " ======\n\n" " =======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format " * %s\n" - :body-number-list-format " # %s\n" - ;; :body-list-prefix "LISTSTART" - ;; :body-list-suffix "LISTEND" - - ;; this is ignored! [2010/02/02:rpg] - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") - ) - ("tikiwiki" - :file-suffix ".txt" - :key-binding ?U - - ;; lifted from wikipedia exporter - :header-prefix "" - :header-suffix "" - - :title-format "-= %s =-\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("! " "!! " "!!! " "!!!! " - "!!!!! " "!!!!!! " "!!!!!!! ") - :body-section-header-suffix (" \n" " \n" " \n" - " \n" " \n" " \n") - - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s " - :body-line-wrap nil - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - ;; :body-list-prefix "LISTSTART" - ;; :body-list-suffix "LISTEND" - :blockquote-start "\n^\n" - :blockquote-end "^\n\n" - :body-newline-paragraph "\n" - :bold-format "__%s__" - :italic-format "''%s''" - :underline-format "===%s===" - :strikethrough-format "--%s--" - :code-format "-+%s+-" - :verbatim-format "~pp~%s~/pp~" - ) - ) - "A assoc list of property lists to specify export definitions" -) - -(setq org-generic-export-type "demo") - -(defvar org-export-generic-section-type "") -(defvar org-export-generic-section-suffix "") - -;;;###autoload -(defun org-set-generic-type (type definition) - "Adds a TYPE and DEFINITION to the existing list of defined generic -export definitions." - (aput 'org-generic-alist type definition)) - -;;; helper functions for org-set-generic-type -(defvar org-export-generic-keywords nil) -(defmacro* def-org-export-generic-keyword (keyword - &key documentation - type) - "Define KEYWORD as a legitimate element for inclusion in -the body of an org-set-generic-type definition." - `(progn - (pushnew ,keyword org-export-generic-keywords) - ;; TODO: push the documentation and type information - ;; somewhere where it will do us some good. - )) - -(def-org-export-generic-keyword :body-newline-paragraph - :documentation "Bound either to NIL or to a pattern to be -inserted in the output for every blank line in the input. - The intention is to handle formats where text is flowed, and -newlines are interpreted as significant \(e.g., as indicating -preformatted text\). A common non-nil value for this keyword -is \"\\n\". Should typically be combined with a value for -:body-line-format that does NOT end with a newline." - :type string) - -;;; fontification keywords -(def-org-export-generic-keyword :bold-format) -(def-org-export-generic-keyword :italic-format) -(def-org-export-generic-keyword :underline-format) -(def-org-export-generic-keyword :strikethrough-format) -(def-org-export-generic-keyword :code-format) -(def-org-export-generic-keyword :verbatim-format) - - - - -(defun org-export-generic-remember-section (type suffix &optional prefix) - (setq org-export-generic-section-type type) - (setq org-export-generic-section-suffix suffix) - (if prefix - (insert prefix)) -) - -(defun org-export-generic-check-section (type &optional prefix suffix) - "checks to see if type is already in use, or we're switching parts -If we're switching, then insert a potentially previously remembered -suffix, and insert the current prefix immediately and then save the -suffix a later change time." - - (when (not (equal type org-export-generic-section-type)) - (if org-export-generic-section-suffix - (insert org-export-generic-section-suffix)) - (setq org-export-generic-section-type type) - (setq org-export-generic-section-suffix suffix) - (if prefix - (insert prefix)))) - -;;;###autoload -(defun org-export-generic (arg) - "Export the outline as generic output. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines. The default is 3." - (interactive "P") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - - helpstart - (bogus (mapc (lambda (x) - (setq helpstart - (concat helpstart "\[" - (char-to-string - (plist-get (cdr x) :key-binding)) - "] " (car x) "\n"))) - org-generic-alist)) - - (help (concat helpstart " - -\[ ] the current setting of the org-generic-export-type variable -")) - - (cmds - - (append - (mapcar (lambda (x) - (list - (plist-get (cdr x) :key-binding) - (car x))) - org-generic-alist) - (list (list ? "default")))) - - r1 r2 ass - - ;; read in the type to use - (export-plist - (progn - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Generic Styles Help*" - (princ help)) - (org-fit-window-to-buffer (get-buffer-window - "*Org Export/Generic Styles Help*")) - (message "Select command: ") - (setq r1 (read-char-exclusive)))) - (setq r2 (if (< r1 27) (+ r1 96) r1)) - (unless (setq ass (cadr (assq r2 cmds))) - (error "No command associated with key %c" r1)) - - (cdr (assoc - (if (equal ass "default") org-generic-export-type ass) - org-generic-alist)))) - - (custom-times org-display-custom-times) - (org-generic-current-indentation '(0 . 0)) - (level 0) (old-level 0) line txt lastwastext - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filesuffix (or (plist-get export-plist :file-suffix) ".foo")) - (filename (concat (file-name-as-directory - (org-export-directory :ascii opt-plist)) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - filesuffix)) - (filename (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename filesuffix) - filename)) - (buffer (find-file-noselect filename)) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory bfname)))) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) -; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (org-export-current-backend 'org-export-generic) - (lines (org-split-string - (org-export-preprocess-string - region - :for-backend 'ascii - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get export-plist :drawers-export) - :tags (plist-get export-plist :tags-export) - :priority (plist-get export-plist :priority-export) - :footnotes (plist-get export-plist :footnotes-export) - :timestamps (plist-get export-plist :timestamps-export) - :todo-keywords (plist-get export-plist :todo-keywords-export) - :verbatim-multiline t - :select-tags (plist-get export-plist :select-tags-export) - :exclude-tags (plist-get export-plist :exclude-tags-export) - :emph-multiline t - :archived-trees - (plist-get export-plist :archived-trees-export) - :add-text (plist-get opt-plist :text)) - "\n")) - ;; export-generic plist variables - (withtags (plist-get export-plist :tags-export)) - (tagsintoc (plist-get export-plist :toc-tags-export)) - (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) "")) - (tocdepth (plist-get export-plist :toc-indent-depth)) - (tocindentchar (plist-get export-plist :toc-indent-char)) - (tocsecnums (plist-get export-plist :toc-section-numbers)) - (tocsecnumform (plist-get export-plist :toc-section-number-format)) - (tocformat (plist-get export-plist :toc-format)) - (tocformtodo (plist-get export-plist :toc-format-with-todo)) - (tocprefix (plist-get export-plist :toc-prefix)) - (tocsuffix (plist-get export-plist :toc-suffix)) - (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix)) - (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix)) - (bodyfixedform (or (plist-get export-plist :body-line-fixed-format) - "%s")) - (listprefix (plist-get export-plist :body-list-prefix)) - (listsuffix (plist-get export-plist :body-list-suffix)) - (listformat (or (plist-get export-plist :body-list-format) "%s\n")) - (numlistleavenum - (plist-get export-plist :body-number-list-leave-number)) - (numlistprefix (plist-get export-plist :body-number-list-prefix)) - (numlistsuffix (plist-get export-plist :body-number-list-suffix)) - (numlistformat - (or (plist-get export-plist :body-number-list-format) "%s\n")) - (listchecktodo - (or (plist-get export-plist :body-list-checkbox-todo) "\\1")) - (listcheckdone - (or (plist-get export-plist :body-list-checkbox-done) "\\1")) - (listcheckhalf - (or (plist-get export-plist :body-list-checkbox-half) "\\1")) - (listchecktodoend - (or (plist-get export-plist :body-list-checkbox-todo-end) "")) - (listcheckdoneend - (or (plist-get export-plist :body-list-checkbox-done-end) "")) - (listcheckhalfend - (or (plist-get export-plist :body-list-checkbox-half-end) "")) - (bodytablestart - (or (plist-get export-plist :body-table-start) "")) - (bodytableend - (or (plist-get export-plist :body-table-end) "")) - (bodytablerowstart - (or (plist-get export-plist :body-table-row-start) "")) - (bodytablerowend - (or (plist-get export-plist :body-table-row-end) "")) - (bodytablecellstart - (or (plist-get export-plist :body-table-cell-start) "")) - (bodytablecellend - (or (plist-get export-plist :body-table-cell-end) "")) - (bodytablefirstcellstart - (or (plist-get export-plist :body-table-first-cell-start) "")) - (bodytableinteriorcellstart - (or (plist-get export-plist :body-table-interior-cell-start) "")) - (bodytableinteriorcellend - (or (plist-get export-plist :body-table-interior-cell-end) "")) - (bodytablelastcellend - (or (plist-get export-plist :body-table-last-cell-end) "")) - (bodytablehlinestart - (or (plist-get export-plist :body-table-hline-start) " \\1")) - (bodytablehlineend - (or (plist-get export-plist :body-table-hline-end) "")) - - - - (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph)) - (bodytextpre (plist-get export-plist :body-text-prefix)) - (bodytextsuf (plist-get export-plist :body-text-suffix)) - (bodylinewrap (plist-get export-plist :body-line-wrap)) - (bodylineform (or (plist-get export-plist :body-line-format) "%s")) - (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t")) - (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n")) - - ;; dynamic variables used heinously in fontification - ;; not referenced locally... - (format-boldify (plist-get export-plist :bold-format)) - (format-italicize (plist-get export-plist :italic-format)) - (format-underline (plist-get export-plist :underline-format)) - (format-strikethrough (plist-get export-plist :strikethrough-format)) - (format-code (plist-get export-plist :code-format)) - (format-verbatim (plist-get export-plist :verbatim-format)) - - - - thetoc toctags have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (find-file-noselect filename) - - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (switch-to-buffer-other-window buffer) - (erase-buffer) - (fundamental-mode) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc umax) - - ;; File header - (if title - (insert - (org-export-generic-header title export-plist - :title-prefix - :title-format - :title-suffix))) - - (if (and (or author email) - (plist-get export-plist :author-export)) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if email (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date (plist-get export-plist :date-export)) - (insert - (org-export-generic-header date export-plist - :date-prefix - :date-format - :date-suffix))) - - ;; export the table of contents first - (if (plist-get export-plist :toc-export) - (progn - (push - (org-export-generic-header (nth 3 lang-words) export-plist - :toc-header-prefix - :toc-header-format - :toc-header-suffix) - thetoc) - - (if tocprefix - (push tocprefix thetoc)) - - (mapc '(lambda (line) - (if (string-match org-todo-line-regexp line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-generic txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (not tagsintoc) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt)) - ; include tags but formated - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") - txt) - (progn - (setq - toctags - (org-export-generic-header - (match-string 1 txt) - export-plist :toc-tags-prefix - :toc-tags-format :toc-tags-suffix)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt) - (setq txt (replace-match "" t t txt))) - (setq toctags tocnotagsstr))) - - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - - (if (<= level umax-toc) - (progn - (push - (concat - - (make-string - (* (max 0 (- level org-min-level)) tocdepth) - tocindentchar) - - (if tocsecnums - (format tocsecnumform - (org-section-number level)) - "") - - (format - (if todo tocformtodo tocformat) - txt) - - toctags) - - thetoc) - (setq org-last-level level)) - )))) - lines) - (if tocsuffix - (push tocsuffix thetoc)) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (org-export-generic-check-section "top") - (while (setq line (pop lines)) - (when (and link-buffer (string-match org-outline-regexp-bol line)) - (org-export-generic-push-links (nreverse link-buffer)) - (setq link-buffer nil)) - (setq wrap nil) - ;; Remove the quoted HTML tags. - ;; XXX - (setq line (org-html-expand-for-generic line)) - ;; Replace links with the description when possible - ;; XXX - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc0 (match-string 3 line) - desc (or desc0 (match-string 1 line))) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (substring link 8) - org-export-code-refs))) - t t line)) - (setq rpl (concat "[" - (or (match-string 3 line) (match-string 1 line)) - "]")) - (when (and desc0 (not (equal desc0 link))) - (if org-export-generic-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc))))) - (setq line (replace-match rpl t t line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; - ;; a Headline - ;; - (org-export-generic-check-section "headline") - - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (org-generic-level-start level old-level txt umax export-plist lines) - (setq old-level level)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - ;; - ;; a Table - ;; - (org-export-generic-check-section "table") - - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate table lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-generic-current-indentation)) - (org-format-table-generic table-buffer) - "\n") "\n"))) - - ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line) - ;; - ;; pre-formatted text - ;; - (setq line (replace-match "\\1" nil nil line)) - - (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf) - - (insert (format bodyfixedform line))) - - ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line) - ;; if the bullet list item is an asterisk, the leading space is /mandatory/ - ;; [2010/02/02:rpg] - (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line)) - ;; - ;; plain list item - ;; TODO: nested lists - ;; - ;; first add a line break between any previous paragraph or line item and this - ;; one - (when bodynewline-paragraph - (insert bodynewline-paragraph)) - - ;; I believe this gets rid of leading whitespace. - (setq line (replace-match "" nil nil line)) - - ;; won't this insert the suffix /before/ the last line of the list? - ;; also isn't it spoofed by bulleted lists that have a line skip between the list items - ;; unless 'org-empty-line-terminates-plain-lists' is true? - (org-export-generic-check-section "liststart" listprefix listsuffix) - - ;; deal with checkboxes - (cond - ((string-match "^\\(\\[ \\]\\)[ \t]*" line) - (setq line (concat (replace-match listchecktodo nil nil line) - listchecktodoend))) - ((string-match "^\\(\\[X\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckdone nil nil line) - listcheckdoneend))) - ((string-match "^\\(\\[/\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckhalf nil nil line) - listcheckhalfend))) - ) - - (insert (format listformat (org-export-generic-fontify line)))) - ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line) - ;; - ;; numbered list item - ;; - ;; TODO: nested lists - ;; - (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line)) - - (org-export-generic-check-section "numliststart" - numlistprefix numlistsuffix) - - ;; deal with checkboxes - ;; TODO: whoops; leaving the numbers is a problem for ^ matching - (cond - ((string-match "\\(\\[ \\]\\)[ \t]*" line) - (setq line (concat (replace-match listchecktodo nil nil line) - listchecktodoend))) - ((string-match "\\(\\[X\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckdone nil nil line) - listcheckdoneend))) - ((string-match "\\(\\[/\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckhalf nil nil line) - listcheckhalfend))) - ) - - (insert (format numlistformat (org-export-generic-fontify line)))) - - ((equal line "ORG-BLOCKQUOTE-START") - (setq line blockquotestart)) - ((equal line "ORG-BLOCKQUOTE-END") - (setq line blockquoteend)) - ((string-match "^\\s-*$" line) - ;; blank line - (if bodynewline-paragraph - (insert bodynewline-paragraph))) - (t - ;; - ;; body - ;; - (org-export-generic-check-section "body" bodytextpre bodytextsuf) - - (setq line - (org-export-generic-fontify line)) - - ;; XXX: properties? list? - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) - (setq line (replace-match "\\1\\3:" t nil line))) - - (setq line (org-fix-indentation line org-generic-current-indentation)) - - ;; Remove forced line breaks - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - - (if bodylinewrap - ;; XXX: was dependent on wrap var which was calculated by??? - (if (> (length line) bodylinewrap) - (setq line - (org-export-generic-wrap line bodylinewrap)) - (setq line line))) - (insert (format bodylineform line))))) - - ;; if we're at a level > 0; insert the closing body level stuff - (let ((counter 0)) - (while (> (- level counter) 0) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 - (- level counter))) - (setq counter (1+ counter)))) - - (org-export-generic-check-section "bottom") - - (org-export-generic-push-links (nreverse link-buffer)) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - (save-buffer) - - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (goto-char (point-min)))) - - -(defun org-export-generic-format (export-plist prop &optional len n reverse) - "converts a property specification to a string given types of properties - -The EXPORT-PLIST should be defined as the lookup plist. -The PROP should be the property name to search for in it. -LEN is set to the length of multi-characters strings to generate (or 0) -N is the tree depth -REVERSE means to reverse the list if the plist match is a list - " - (let* ((prefixtype (plist-get export-plist prop)) - subtype) - (cond - ((null prefixtype) "") - ((and len (char-or-string-p prefixtype) (not (stringp prefixtype))) - ;; sequence of chars - (concat (make-string len prefixtype) "\n")) - ((stringp prefixtype) - prefixtype) - ((and n (listp prefixtype)) - (if reverse - (setq prefixtype (reverse prefixtype))) - (setq subtype (if (> n (length prefixtype)) - (car (last prefixtype)) - (nth (1- n) prefixtype))) - (if (stringp subtype) - subtype - (concat (make-string len subtype) "\n"))) - (t "")) - )) - -(defun org-export-generic-header (header export-plist - prefixprop formatprop postfixprop - &optional n reverse) - "convert a header to an output string given formatting property names" - (let* ((formatspec (plist-get export-plist formatprop)) - (len (length header))) - (concat - (org-export-generic-format export-plist prefixprop len n reverse) - (format (or formatspec "%s") header) - (org-export-generic-format export-plist postfixprop len n reverse)) - )) - -(defun org-export-generic-preprocess (parameters) - "Do extra work for ASCII export" - ;; Put quotes around verbatim text - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (goto-char (match-end 2)) - (backward-delete-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2))) - ;; Remove target markers - (goto-char (point-min)) - (while (re-search-forward "<<]*\\)>>>?\\([ \t]*\\)" nil t) - (replace-match "\\1\\2"))) - -(defun org-html-expand-for-generic (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - -(defun org-export-generic-wrap (line where) - "Wrap LINE at or before WHERE." - (let* ((ind (org-get-indentation line)) - (indstr (make-string ind ?\ )) - (len (length line)) - (result "") - pos didfirst) - (while (> len where) - (catch 'found - (loop for i from where downto (/ where 2) do - (and (equal (aref line i) ?\ ) - (setq pos i) - (throw 'found t)))) - (if pos - (progn - (setq result - (concat result - (if didfirst indstr "") - (substring line 0 pos) - "\n")) - (setq didfirst t) - (setq line (substring line (1+ pos))) - (setq len (length line))) - (setq result (concat result line)) - (setq len 0))) - (concat result indstr line))) - -(defun org-export-generic-push-links (link-buffer) - "Push out links in the buffer." - (when link-buffer - ;; We still have links to push out. - (insert "\n") - (let ((ind "")) - (save-match-data - (if (save-excursion - (re-search-backward - "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) - (setq ind (or (match-string 2) - (make-string (length (match-string 3)) ?\ ))))) - (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) - link-buffer)) - (insert "\n"))) - -(defun org-generic-level-start (level old-level title umax export-plist - &optional lines) - "Insert a new level in a generic export." - (let ((n (- level umax 1)) - (ind 0) - (diff (- level old-level)) (counter 0) - (secnums (plist-get export-plist :body-header-section-numbers)) - (secnumformat - (plist-get export-plist :body-header-section-number-format)) - char tagstring) - (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match "" t t title)))) - - (cond - ;; going deeper - ((> level old-level) - (while (< (+ old-level counter) (1- level)) - (insert - (org-export-generic-format export-plist :body-section-prefix 0 - (+ old-level counter))) - (setq counter (1+ counter)) - )) - ;; going up - ((< level old-level) - (while (> (- old-level counter) (1- level)) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 - (- old-level counter))) - (setq counter (1+ counter)) - )) - ;; same level - ((= level old-level) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 level)) - ) - ) - (insert - (org-export-generic-format export-plist :body-section-prefix 0 level)) - - (if (and org-export-with-section-numbers - secnums - (or (not (numberp secnums)) - (< level secnums))) - (setq title - (concat (format (or secnumformat "%s ") - (org-section-number level)) title))) - - ;; handle tags and formatting - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title) - (progn - (if (plist-get export-plist :body-tags-export) - (setq tagstring (org-export-generic-header (match-string 1 title) - export-plist - :body-tags-prefix - :body-tags-format - :body-tags-suffix))) - (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title) - (setq title (replace-match "" t t title))) - (setq tagstring (plist-get export-plist :body-tags-none-string))) - - (insert - (org-export-generic-header title export-plist - :body-section-header-prefix - :body-section-header-format - :body-section-header-suffix - level)) - (if tagstring - (insert tagstring)) - - (setq org-generic-current-indentation '(0 . 0)))) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defvar org-table-colgroup-info nil) -(defun org-format-table-generic (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - ;; Get rid of the vertical lines except for grouping - (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) - (rtn (list bodytablestart)) line vl1 start) - (while (setq line (pop lines)) - (setq line (concat bodytablerowstart line)) - (if (string-match org-table-hline-regexp line) - (and (string-match "|\\(.*\\)|" line) - (setq line (replace-match (concat bodytablehlinestart bodytablehlineend) t nil line))) - (setq start 0 vl1 vl) - (if (string-match "|\\(.*\\)|" line) - (setq line (replace-match (concat bodytablefirstcellstart bodytablecellstart " \\1 " bodytablecellend bodytablelastcellend) t nil line))) - (while (string-match "|" line start) - (setq start (+ (match-end 0) (length (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart)))) - (or (pop vl1) (setq line (replace-match (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart) t t line))))) - (setq line (concat line bodytablerowend)) - (push line rtn)) - (setq rtn (cons bodytableend rtn)) - (nreverse rtn)))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) - - -;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg] -(defvar org-export-generic-emphasis-alist - '(("*" format-boldify nil) - ("/" format-italicize nil) - ("_" format-underline nil) - ("+" format-strikethrough nil) - ("=" format-code t) - ("~" format-verbatim t)) - "Alist of org format -> formatting variables for fontification. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a variable name, set in org-export-generic. That -variable will be dereferenced to obtain a formatting string to wrap -fontified text with. -The third element decides whether to protect converted text from other -conversions.") - -;;; Cargo-culted from the latex translation. I couldn't figure out how -;;; to keep the structure since the generic export operates on lines, rather -;;; than on a buffer as in the latex export, meaning that none of the -;;; search forward code could be kept. This led me to rewrite the -;;; whole thing recursively. A huge lose for efficiency (potentially), -;;; but I couldn't figure out how to make the looping work. -;;; Worse, it's /doubly/ recursive, because this function calls -;;; org-export-generic-emph-format, which can call it recursively... -;;; [2010/05/20:rpg] -(defun org-export-generic-fontify (string) - "Convert fontification according to generic rules." - (if (string-match org-emph-re string) - ;; The match goes one char after the *string*, except at the end of a line - (let ((emph (assoc (match-string 3 string) - org-export-generic-emphasis-alist)) - (beg (match-beginning 0)) - (end (match-end 0))) - (unless emph - (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\"" - (match-string 3 string))) - ;; now we need to determine whether we have strikethrough or - ;; a list, which is a bit nasty - (if (and (equal (match-string 3 string) "+") - (save-match-data - (string-match "\\`-+\\'" (match-string 4 string)))) - ;; a list --- skip this match and recurse on the point after the - ;; first emph char... - (concat (substring string 0 (1+ (match-beginning 3))) - (org-export-generic-fontify (substring string (match-beginning 3)))) - (concat (substring string 0 beg) ;; part before the match - (match-string 1 string) - (org-export-generic-emph-format (second emph) - (match-string 4 string) - (third emph)) - (or (match-string 5 string) "") - (org-export-generic-fontify (substring string end))))) - string)) - -(defun org-export-generic-emph-format (format-varname string protect) - "Return a string that results from applying the markup indicated by -FORMAT-VARNAME to STRING." - (let ((format (symbol-value format-varname))) - (let ((string-to-emphasize - (if protect - string - (org-export-generic-fontify string)))) - (if format - (format format string-to-emphasize) - string-to-emphasize)))) - -(provide 'org-generic) -(provide 'org-export-generic) - -;;; org-export-generic.el ends here -- cgit v1.2.3