Manually revert to the Release 7.8.04 tag.
[org-mode.git] / contrib / lisp / org-export-generic.el
blob436badcb8e8d280b2d974f7b5347add7f9c3d0cc
1 ;; org-export-generic.el --- Export frameworg with custom backends
3 ;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
5 ;; Author: Wes Hardaker <hardaker at users dot sourceforge dot net>
6 ;; Keywords: outlines, hypermedia, calendar, wp, export
7 ;; Homepage: http://orgmode.org
8 ;; Version: 6.25trans
9 ;; Acks: Much of this code was stolen form the ascii export from Carsten
11 ;; This file is not yet part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; ----------------------------------------------------------------------
28 ;; OVERVIEW
30 ;; org-export-generic is basically a simple translation system that
31 ;; knows how to parse at least most of a .org buffer and then add
32 ;; various formatting prefixes before and after each section type. It
33 ;; does this by examining a property list stored in org-generic-alist.
34 ;; You can dynamically add propety lists of your own using the
35 ;; org-set-generic-type function:
37 ;; (org-set-generic-type
38 ;; "really-basic-text"
39 ;; '(:file-suffix ".txt"
40 ;; :key-binding ?R
42 ;; :title-format "=== %s ===\n"
43 ;; :body-header-section-numbers t
44 ;; :body-header-section-number-format "%s) "
45 ;; :body-section-header-prefix "\n"
46 ;; :body-section-header-suffix "\n"
47 ;; :body-line-format " %s\n"
48 ;; :body-line-wrap 75
49 ;; ))
51 ;; Note: Upper case key-bindings are reserved for your use. Lower
52 ;; case key bindings may conflict with future export-generic
53 ;; publications.
55 ;; Then run org-export (ctrl-c ctrl-e) and select generic or run
56 ;; org-export-generic. You'll then be prompted with a list of export
57 ;; types to choose from which will include your new type assigned to
58 ;; the key "r".
60 ;; ----------------------------------------------------------------------
62 ;; TODO (non-ordered)
63 ;; * handle function references
64 ;; * handle other types of multi-complex-listy-things to do
65 ;; ideas: (t ?- "%s" ?-)
66 ;; * handle indent specifiers better
67 ;; ideas: (4 ?\ "%s")
68 ;; * need flag to remove indents from body text
69 ;; * handle links
70 ;; * handle internationalization strings better
71 ;; * date/author/etc needs improvment (internationalization too)
72 ;; * allow specifying of section ordering
73 ;; ideas: :ordering ("header" "toc" "body" "footer")
74 ;; ^ matches current hard coded ordering
75 ;; * err, actually *do* a footer
76 ;; * deal with usage of org globals
77 ;; *** should we even consider them, or let the per-section specifiers do it
78 ;; *** answer: remove; mostly removed now
79 ;; * deal with interactive support for picking a export specifier label
80 ;; * char specifiers that need extra length because of formatting
81 ;; idea: (?- 4) for 4-longer
82 ;; * centering specifier
83 ;; idea: ('center " -- %s -- ")
84 ;; * remove more of the unneeded export-to-ascii copy code
85 ;; * tags
86 ;; *** supported now, but need separate format per tag
87 ;; *** allow different open/closing prefixes
88 ;; * properties
89 ;; * drawers
90 ;; * Escape camel-case for wiki exporters.
91 ;; * Adjust to depth limits on headers --- need to roll-over from headers
92 ;; to lists, as per other exporters
93 ;; * optmization (many plist extracts should be in let vars)
94 ;; * define defcustom spec for the specifier list
95 ;; * fonts: at least monospace is not handled at all here.
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
99 ;;; Commentary:
101 (require 'org-exp)
102 (require 'assoc)
104 (defgroup org-export-generic nil
105 "Options specific for ASCII export of Org-mode files."
106 :tag "Org Export ASCII"
107 :group 'org-export)
109 (defcustom org-export-generic-links-to-notes t
110 "Non-nil means convert links to notes before the next headline.
111 When nil, the link will be exported in place. If the line becomes long
112 in this way, it will be wrapped."
113 :group 'org-export-generic
114 :type 'boolean)
117 (defvar org-generic-current-indentation nil) ; For communication
119 (defvar org-generic-alist
122 ;; generic DEMO exporter
124 ;; (this tries to use every specifier for demo purposes)
126 ("demo"
127 :file-suffix ".txt"
128 :key-binding ?d
130 :header-prefix "<header>\n"
131 :header-suffix "</header>\n"
133 :author-export t
134 :tags-export t
136 :drawers-export t
139 :title-prefix ?=
140 :title-format "<h1>%s</h1>\n"
141 :title-suffix ?=
143 :date-export t
144 :date-prefix "<date>"
145 :date-format "<br /><b>Date:</b> <i>%s</i><br />"
146 :date-suffix "</date>\n\n"
148 :toc-export t
149 :toc-header-prefix "<tocname>\n"
150 :toc-header-format "__%s__\n"
151 :toc-header-suffix "</tocname>\n"
153 :toc-prefix "<toc>\n"
154 :toc-suffix "</toc>\n"
156 :toc-section-numbers t
157 :toc-section-number-format "\#(%s) "
158 :toc-format "--%s--"
159 :toc-format-with-todo "!!%s!!\n"
160 :toc-indent-char ?\
161 :toc-indent-depth 4
163 :toc-tags-export t
164 :toc-tags-prefix " <tags>"
165 :toc-tags-format "*%s*"
166 :toc-tags-suffix "</tags>\n"
167 :toc-tags-none-string "\n"
169 :body-header-section-numbers 3 ; t = all, nil = none
171 ; lists indicate different things per level
172 ; list contents or straight value can either be a
173 ; ?x char reference for printing strings that match the header len
174 ; "" string to print directly
175 :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
176 "<h4>" "<h5>" "<h6>")
177 :body-section-header-format "%s"
178 :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
179 "</h4>\n" "</h5>\n" "</h6>\n")
181 :timestamps-export t
182 :priorities-export t
183 :todo-keywords-export t
185 :body-tags-export t
186 :body-tags-prefix " <tags>"
187 :body-tags-suffix "</tags>\n"
189 ; section prefixes/suffixes can be direct strings or lists as well
190 :body-section-prefix "<secprefix>\n"
191 :body-section-suffix "</secsuffix>\n"
192 ; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
193 ; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
196 ; if preformated text should be included (eg, : prefixed)
197 :body-line-export-preformated t
198 :body-line-fixed-prefix "<pre>\n"
199 :body-line-fixed-suffix "\n</pre>\n"
200 :body-line-fixed-format "%s\n"
203 :body-list-prefix "<list>\n"
204 :body-list-suffix "</list>\n"
205 :body-list-format "<li>%s</li>\n"
207 :body-number-list-prefix "<ol>\n"
208 :body-number-list-suffix "</ol>\n"
209 :body-number-list-format "<li>%s</li>\n"
210 :body-number-list-leave-number t
212 :body-list-checkbox-todo "<checkbox type=\"todo\">"
213 :body-list-checkbox-todo-end "</checkbox (todo)>"
214 :body-list-checkbox-done "<checkbox type=\"done\">"
215 :body-list-checkbox-done-end "</checkbox (done)>"
216 :body-list-checkbox-half "<checkbox type=\"half\">"
217 :body-list-checkbox-half-end "</checkbox (half)>"
222 ; other body lines
223 :body-line-format "%s"
224 :body-line-wrap 60 ; wrap at 60 chars
226 ; print above and below all body parts
227 :body-text-prefix "<p>\n"
228 :body-text-suffix "</p>\n"
233 ;; ascii exporter
235 ;; (close to the original ascii specifier)
237 ("ascii"
238 :file-suffix ".txt"
239 :key-binding ?a
241 :header-prefix ""
242 :header-suffix ""
244 :title-prefix ?=
245 :title-format "%s\n"
246 :title-suffix ?=
248 :date-export t
249 :date-prefix ""
250 :date-format "Date: %s\n"
251 :date-suffix ""
253 :toc-header-prefix ""
254 :toc-header-format "%s\n"
255 :toc-header-suffix ?=
257 :toc-export t
258 :toc-section-numbers t
259 :toc-section-number-format "%s "
260 :toc-format "%s\n"
261 :toc-format-with-todo "%s (*)\n"
262 :toc-indent-char ?\
263 :toc-indent-depth 4
265 :body-header-section-numbers 3
266 :body-section-prefix "\n"
268 ; :body-section-header-prefix "\n"
269 ; :body-section-header-format "%s\n"
270 ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
272 :body-section-header-prefix ("" "" "" "* " " + " " - ")
273 :body-section-header-format "%s\n"
274 :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
276 ; :body-section-marker-prefix ""
277 ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
278 ; :body-section-marker-suffix "\n"
280 :body-line-export-preformated t
281 :body-line-format "%s\n"
282 :body-line-wrap 75
284 ; :body-text-prefix "<t>\n"
285 ; :body-text-suffix "</t>\n"
288 :body-bullet-list-prefix (?* ?+ ?-)
289 ; :body-bullet-list-suffix (?* ?+ ?-)
293 ;; wikipedia
295 ("wikipedia"
296 :file-suffix ".txt"
297 :key-binding ?w
299 :header-prefix ""
300 :header-suffix ""
302 :title-format "= %s =\n"
304 :date-export nil
306 :toc-export nil
308 :body-header-section-numbers nil
309 :body-section-prefix "\n"
311 :body-section-header-prefix ("= " "== " "=== "
312 "==== " "===== " "====== ")
313 :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
314 " ====\n\n" " =====\n\n" " ======\n\n")
316 :body-line-export-preformated t ;; yes/no/maybe???
317 :body-line-format "%s\n"
318 :body-line-wrap 75
320 :body-line-fixed-format " %s\n"
322 :body-list-format "* %s\n"
323 :body-number-list-format "# %s\n"
325 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
328 ;; internet-draft .xml for xml2rfc exporter
330 ("ietfid"
331 ;; this tries to use every specifier for demo purposes
332 :file-suffix ".xml"
333 :key-binding ?i
335 :title-prefix "<?xml version=\"1.0\"\?>
336 <!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [
337 <!ENTITY rfcs PUBLIC '' 'blah'>
338 <?rfc strict=\"yes\" ?>
339 <?rfc toc=\"yes\" ?>
340 <?rfc tocdepth=\"4\" ?>
341 <?rfc symrefs=\"yes\" ?>
342 <?rfc compact=\"yes\" ?>
343 <?rfc subcompact=\"no\" ?>
344 <rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\">
345 <front>
347 :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n"
348 :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\">
349 <organization>Comany, Inc..</organization>
350 <address>
351 <postal>
352 <street></street>
353 <city></city>
354 <region></region>
355 <code></code>
356 <country></country>
357 </postal>
358 <phone></phone>
359 <email></email>
360 </address>
361 </author>
362 <date month=\"FILLMONTH\" year=\"FILLYEAR\"/>
363 <area>Operations and Management</area>
364 <workgroup>FIXME</workgroup>
365 <abstract>\n"
366 :date-export nil
368 :toc-export nil
370 :body-header-section-numbers nil
372 :body-section-header-format "<section title=\"%s\">\n"
373 :body-section-suffix "</section>\n"
375 ; if preformated text should be included (eg, : prefixed)
376 :body-line-export-preformated t
377 :body-line-fixed-prefix "<figure>\n<artwork>\n"
378 :body-line-fixed-suffix "\n</artwork>\n</figure>\n"
380 ; other body lines
381 :body-line-format "%s"
382 :body-line-wrap 75
384 ; print above and below all body parts
385 :body-text-prefix "<t>\n"
386 :body-text-suffix "</t>\n"
388 :body-list-prefix "<list style=\"symbols\">\n"
389 :body-list-suffix "</list>\n"
390 :body-list-format "<t>%s</t>\n"
393 ("trac-wiki"
394 :file-suffix ".txt"
395 :key-binding ?T
397 ;; lifted from wikipedia exporter
398 :header-prefix ""
399 :header-suffix ""
401 :title-format "= %s =\n"
403 :date-export nil
405 :toc-export nil
407 :body-header-section-numbers nil
408 :body-section-prefix "\n"
410 :body-section-header-prefix (" == " " === " " ==== "
411 " ===== " )
412 :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n"
413 " =====\n\n" " ======\n\n" " =======\n\n")
415 :body-line-export-preformated t ;; yes/no/maybe???
416 :body-line-format "%s\n"
417 :body-line-wrap 75
419 :body-line-fixed-format " %s\n"
421 :body-list-format " * %s\n"
422 :body-number-list-format " # %s\n"
423 ;; :body-list-prefix "LISTSTART"
424 ;; :body-list-suffix "LISTEND"
426 ;; this is ignored! [2010/02/02:rpg]
427 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
429 ("tikiwiki"
430 :file-suffix ".txt"
431 :key-binding ?U
433 ;; lifted from wikipedia exporter
434 :header-prefix ""
435 :header-suffix ""
437 :title-format "-= %s =-\n"
439 :date-export nil
441 :toc-export nil
443 :body-header-section-numbers nil
444 :body-section-prefix "\n"
446 :body-section-header-prefix ("! " "!! " "!!! " "!!!! "
447 "!!!!! " "!!!!!! " "!!!!!!! ")
448 :body-section-header-suffix (" \n" " \n" " \n"
449 " \n" " \n" " \n")
452 :body-line-export-preformated t ;; yes/no/maybe???
453 :body-line-format "%s "
454 :body-line-wrap nil
456 :body-line-fixed-format " %s\n"
458 :body-list-format "* %s\n"
459 :body-number-list-format "# %s\n"
460 ;; :body-list-prefix "LISTSTART"
461 ;; :body-list-suffix "LISTEND"
462 :blockquote-start "\n^\n"
463 :blockquote-end "^\n\n"
464 :body-newline-paragraph "\n"
465 :bold-format "__%s__"
466 :italic-format "''%s''"
467 :underline-format "===%s==="
468 :strikethrough-format "--%s--"
469 :code-format "-+%s+-"
470 :verbatim-format "~pp~%s~/pp~"
473 "A assoc list of property lists to specify export definitions"
476 (setq org-generic-export-type "demo")
478 (defvar org-export-generic-section-type "")
479 (defvar org-export-generic-section-suffix "")
481 ;;;###autoload
482 (defun org-set-generic-type (type definition)
483 "Adds a TYPE and DEFINITION to the existing list of defined generic
484 export definitions."
485 (aput 'org-generic-alist type definition))
487 ;;; helper functions for org-set-generic-type
488 (defvar org-export-generic-keywords nil)
489 (defmacro* def-org-export-generic-keyword (keyword
490 &key documentation
491 type)
492 "Define KEYWORD as a legitimate element for inclusion in
493 the body of an org-set-generic-type definition."
494 `(progn
495 (pushnew ,keyword org-export-generic-keywords)
496 ;; TODO: push the documentation and type information
497 ;; somewhere where it will do us some good.
500 (def-org-export-generic-keyword :body-newline-paragraph
501 :documentation "Bound either to NIL or to a pattern to be
502 inserted in the output for every blank line in the input.
503 The intention is to handle formats where text is flowed, and
504 newlines are interpreted as significant \(e.g., as indicating
505 preformatted text\). A common non-nil value for this keyword
506 is \"\\n\". Should typically be combined with a value for
507 :body-line-format that does NOT end with a newline."
508 :type string)
510 ;;; fontification keywords
511 (def-org-export-generic-keyword :bold-format)
512 (def-org-export-generic-keyword :italic-format)
513 (def-org-export-generic-keyword :underline-format)
514 (def-org-export-generic-keyword :strikethrough-format)
515 (def-org-export-generic-keyword :code-format)
516 (def-org-export-generic-keyword :verbatim-format)
521 (defun org-export-generic-remember-section (type suffix &optional prefix)
522 (setq org-export-generic-section-type type)
523 (setq org-export-generic-section-suffix suffix)
524 (if prefix
525 (insert prefix))
528 (defun org-export-generic-check-section (type &optional prefix suffix)
529 "checks to see if type is already in use, or we're switching parts
530 If we're switching, then insert a potentially previously remembered
531 suffix, and insert the current prefix immediately and then save the
532 suffix a later change time."
534 (when (not (equal type org-export-generic-section-type))
535 (if org-export-generic-section-suffix
536 (insert org-export-generic-section-suffix))
537 (setq org-export-generic-section-type type)
538 (setq org-export-generic-section-suffix suffix)
539 (if prefix
540 (insert prefix))))
542 ;;;###autoload
543 (defun org-export-generic (arg)
544 "Export the outline as generic output.
545 If there is an active region, export only the region.
546 The prefix ARG specifies how many levels of the outline should become
547 underlined headlines. The default is 3."
548 (interactive "P")
549 (setq-default org-todo-line-regexp org-todo-line-regexp)
550 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
551 (org-infile-export-plist)))
552 (region-p (org-region-active-p))
553 (rbeg (and region-p (region-beginning)))
554 (rend (and region-p (region-end)))
555 (subtree-p
556 (when region-p
557 (save-excursion
558 (goto-char rbeg)
559 (and (org-at-heading-p)
560 (>= (org-end-of-subtree t t) rend)))))
561 (level-offset (if subtree-p
562 (save-excursion
563 (goto-char rbeg)
564 (+ (funcall outline-level)
565 (if org-odd-levels-only 1 0)))
567 (opt-plist (setq org-export-opt-plist
568 (if subtree-p
569 (org-export-add-subtree-options opt-plist rbeg)
570 opt-plist)))
572 helpstart
573 (bogus (mapc (lambda (x)
574 (setq helpstart
575 (concat helpstart "\["
576 (char-to-string
577 (plist-get (cdr x) :key-binding))
578 "] " (car x) "\n")))
579 org-generic-alist))
581 (help (concat helpstart "
583 \[ ] the current setting of the org-generic-export-type variable
586 (cmds
588 (append
589 (mapcar (lambda (x)
590 (list
591 (plist-get (cdr x) :key-binding)
592 (car x)))
593 org-generic-alist)
594 (list (list ? "default"))))
596 r1 r2 ass
598 ;; read in the type to use
599 (export-plist
600 (progn
601 (save-excursion
602 (save-window-excursion
603 (delete-other-windows)
604 (with-output-to-temp-buffer "*Org Export/Generic Styles Help*"
605 (princ help))
606 (org-fit-window-to-buffer (get-buffer-window
607 "*Org Export/Generic Styles Help*"))
608 (message "Select command: ")
609 (setq r1 (read-char-exclusive))))
610 (setq r2 (if (< r1 27) (+ r1 96) r1))
611 (unless (setq ass (cadr (assq r2 cmds)))
612 (error "No command associated with key %c" r1))
614 (cdr (assoc
615 (if (equal ass "default") org-generic-export-type ass)
616 org-generic-alist))))
618 (custom-times org-display-custom-times)
619 (org-generic-current-indentation '(0 . 0))
620 (level 0) (old-level 0) line txt lastwastext
621 (umax nil)
622 (umax-toc nil)
623 (case-fold-search nil)
624 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
625 (filesuffix (or (plist-get export-plist :file-suffix) ".foo"))
626 (filename (concat (file-name-as-directory
627 (org-export-directory :ascii opt-plist))
628 (file-name-sans-extension
629 (or (and subtree-p
630 (org-entry-get (region-beginning)
631 "EXPORT_FILE_NAME" t))
632 (file-name-nondirectory bfname)))
633 filesuffix))
634 (filename (if (equal (file-truename filename)
635 (file-truename bfname))
636 (concat filename filesuffix)
637 filename))
638 (buffer (find-file-noselect filename))
639 (org-levels-open (make-vector org-level-max nil))
640 (odd org-odd-levels-only)
641 (date (plist-get opt-plist :date))
642 (author (plist-get opt-plist :author))
643 (title (or (and subtree-p (org-export-get-title-from-subtree))
644 (plist-get opt-plist :title)
645 (and (not
646 (plist-get opt-plist :skip-before-1st-heading))
647 (org-export-grab-title-from-buffer))
648 (file-name-sans-extension
649 (file-name-nondirectory bfname))))
650 (email (plist-get opt-plist :email))
651 (language (plist-get opt-plist :language))
652 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
653 ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
654 (todo nil)
655 (lang-words nil)
656 (region
657 (buffer-substring
658 (if (org-region-active-p) (region-beginning) (point-min))
659 (if (org-region-active-p) (region-end) (point-max))))
660 (org-export-current-backend 'org-export-generic)
661 (lines (org-split-string
662 (org-export-preprocess-string
663 region
664 :for-backend 'ascii
665 :skip-before-1st-heading
666 (plist-get opt-plist :skip-before-1st-heading)
667 :drawers (plist-get export-plist :drawers-export)
668 :tags (plist-get export-plist :tags-export)
669 :priority (plist-get export-plist :priority-export)
670 :footnotes (plist-get export-plist :footnotes-export)
671 :timestamps (plist-get export-plist :timestamps-export)
672 :todo-keywords (plist-get export-plist :todo-keywords-export)
673 :verbatim-multiline t
674 :select-tags (plist-get export-plist :select-tags-export)
675 :exclude-tags (plist-get export-plist :exclude-tags-export)
676 :emph-multiline t
677 :archived-trees
678 (plist-get export-plist :archived-trees-export)
679 :add-text (plist-get opt-plist :text))
680 "\n"))
681 ;; export-generic plist variables
682 (withtags (plist-get export-plist :tags-export))
683 (tagsintoc (plist-get export-plist :toc-tags-export))
684 (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) ""))
685 (tocdepth (plist-get export-plist :toc-indent-depth))
686 (tocindentchar (plist-get export-plist :toc-indent-char))
687 (tocsecnums (plist-get export-plist :toc-section-numbers))
688 (tocsecnumform (plist-get export-plist :toc-section-number-format))
689 (tocformat (plist-get export-plist :toc-format))
690 (tocformtodo (plist-get export-plist :toc-format-with-todo))
691 (tocprefix (plist-get export-plist :toc-prefix))
692 (tocsuffix (plist-get export-plist :toc-suffix))
693 (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix))
694 (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix))
695 (bodyfixedform (or (plist-get export-plist :body-line-fixed-format)
696 "%s"))
697 (listprefix (plist-get export-plist :body-list-prefix))
698 (listsuffix (plist-get export-plist :body-list-suffix))
699 (listformat (or (plist-get export-plist :body-list-format) "%s\n"))
700 (numlistleavenum
701 (plist-get export-plist :body-number-list-leave-number))
702 (numlistprefix (plist-get export-plist :body-number-list-prefix))
703 (numlistsuffix (plist-get export-plist :body-number-list-suffix))
704 (numlistformat
705 (or (plist-get export-plist :body-number-list-format) "%s\n"))
706 (listchecktodo
707 (or (plist-get export-plist :body-list-checkbox-todo) "\\1"))
708 (listcheckdone
709 (or (plist-get export-plist :body-list-checkbox-done) "\\1"))
710 (listcheckhalf
711 (or (plist-get export-plist :body-list-checkbox-half) "\\1"))
712 (listchecktodoend
713 (or (plist-get export-plist :body-list-checkbox-todo-end) ""))
714 (listcheckdoneend
715 (or (plist-get export-plist :body-list-checkbox-done-end) ""))
716 (listcheckhalfend
717 (or (plist-get export-plist :body-list-checkbox-half-end) ""))
718 (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph))
719 (bodytextpre (plist-get export-plist :body-text-prefix))
720 (bodytextsuf (plist-get export-plist :body-text-suffix))
721 (bodylinewrap (plist-get export-plist :body-line-wrap))
722 (bodylineform (or (plist-get export-plist :body-line-format) "%s"))
723 (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
724 (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
726 ;; dynamic variables used heinously in fontification
727 ;; not referenced locally...
728 (format-boldify (plist-get export-plist :bold-format))
729 (format-italicize (plist-get export-plist :italic-format))
730 (format-underline (plist-get export-plist :underline-format))
731 (format-strikethrough (plist-get export-plist :strikethrough-format))
732 (format-code (plist-get export-plist :code-format))
733 (format-verbatim (plist-get export-plist :verbatim-format))
737 thetoc toctags have-headings first-heading-pos
738 table-open table-buffer link-buffer link desc desc0 rpl wrap)
740 (let ((inhibit-read-only t))
741 (org-unmodified
742 (remove-text-properties (point-min) (point-max)
743 '(:org-license-to-kill t))))
745 (setq org-min-level (org-get-min-level lines level-offset))
746 (setq org-last-level org-min-level)
747 (org-init-section-numbers)
749 (find-file-noselect filename)
751 (setq lang-words (or (assoc language org-export-language-setup)
752 (assoc "en" org-export-language-setup)))
753 (switch-to-buffer-other-window buffer)
754 (erase-buffer)
755 (fundamental-mode)
756 ;; create local variables for all options, to make sure all called
757 ;; functions get the correct information
758 (mapc (lambda (x)
759 (set (make-local-variable (nth 2 x))
760 (plist-get opt-plist (car x))))
761 org-export-plist-vars)
762 (org-set-local 'org-odd-levels-only odd)
763 (setq umax (if arg (prefix-numeric-value arg)
764 org-export-headline-levels))
765 (setq umax-toc umax)
767 ;; File header
768 (if title
769 (insert
770 (org-export-generic-header title export-plist
771 :title-prefix
772 :title-format
773 :title-suffix)))
775 (if (and (or author email)
776 (plist-get export-plist :author-export))
777 (insert (concat (nth 1 lang-words) ": " (or author "")
778 (if email (concat " <" email ">") "")
779 "\n")))
781 (cond
782 ((and date (string-match "%" date))
783 (setq date (format-time-string date)))
784 (date)
785 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
787 (if (and date (plist-get export-plist :date-export))
788 (insert
789 (org-export-generic-header date export-plist
790 :date-prefix
791 :date-format
792 :date-suffix)))
794 ;; export the table of contents first
795 (if (plist-get export-plist :toc-export)
796 (progn
797 (push
798 (org-export-generic-header (nth 3 lang-words) export-plist
799 :toc-header-prefix
800 :toc-header-format
801 :toc-header-suffix)
802 thetoc)
804 (if tocprefix
805 (push tocprefix thetoc))
807 (mapc '(lambda (line)
808 (if (string-match org-todo-line-regexp line)
809 ;; This is a headline
810 (progn
811 (setq have-headings t)
812 (setq level (- (match-end 1) (match-beginning 1)
813 level-offset)
814 level (org-tr-level level)
815 txt (match-string 3 line)
816 todo
817 (or (and org-export-mark-todo-in-toc
818 (match-beginning 2)
819 (not (member (match-string 2 line)
820 org-done-keywords)))
821 ; TODO, not DONE
822 (and org-export-mark-todo-in-toc
823 (= level umax-toc)
824 (org-search-todo-below
825 line lines level))))
826 (setq txt (org-html-expand-for-generic txt))
828 (while (string-match org-bracket-link-regexp txt)
829 (setq txt
830 (replace-match
831 (match-string (if (match-end 2) 3 1) txt)
832 t t txt)))
834 (if (and (not tagsintoc)
835 (string-match
836 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
837 txt))
838 (setq txt (replace-match "" t t txt))
839 ; include tags but formated
840 (if (string-match
841 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$")
842 txt)
843 (progn
844 (setq
845 toctags
846 (org-export-generic-header
847 (match-string 1 txt)
848 export-plist :toc-tags-prefix
849 :toc-tags-format :toc-tags-suffix))
850 (string-match
851 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
852 txt)
853 (setq txt (replace-match "" t t txt)))
854 (setq toctags tocnotagsstr)))
856 (if (string-match quote-re0 txt)
857 (setq txt (replace-match "" t t txt)))
859 (if (<= level umax-toc)
860 (progn
861 (push
862 (concat
864 (make-string
865 (* (max 0 (- level org-min-level)) tocdepth)
866 tocindentchar)
868 (if tocsecnums
869 (format tocsecnumform
870 (org-section-number level))
873 (format
874 (if todo tocformtodo tocformat)
875 txt)
877 toctags)
879 thetoc)
880 (setq org-last-level level))
881 ))))
882 lines)
883 (if tocsuffix
884 (push tocsuffix thetoc))
885 (setq thetoc (if have-headings (nreverse thetoc) nil))))
887 (org-init-section-numbers)
888 (org-export-generic-check-section "top")
889 (while (setq line (pop lines))
890 (when (and link-buffer (string-match org-outline-regexp-bol line))
891 (org-export-generic-push-links (nreverse link-buffer))
892 (setq link-buffer nil))
893 (setq wrap nil)
894 ;; Remove the quoted HTML tags.
895 ;; XXX
896 (setq line (org-html-expand-for-generic line))
897 ;; Replace links with the description when possible
898 ;; XXX
899 (while (string-match org-bracket-link-regexp line)
900 (setq link (match-string 1 line)
901 desc0 (match-string 3 line)
902 desc (or desc0 (match-string 1 line)))
903 (if (and (> (length link) 8)
904 (equal (substring link 0 8) "coderef:"))
905 (setq line (replace-match
906 (format (org-export-get-coderef-format (substring link 8) desc)
907 (cdr (assoc
908 (substring link 8)
909 org-export-code-refs)))
910 t t line))
911 (setq rpl (concat "["
912 (or (match-string 3 line) (match-string 1 line))
913 "]"))
914 (when (and desc0 (not (equal desc0 link)))
915 (if org-export-generic-links-to-notes
916 (push (cons desc0 link) link-buffer)
917 (setq rpl (concat rpl " (" link ")")
918 wrap (+ (length line) (- (length (match-string 0 line)))
919 (length desc)))))
920 (setq line (replace-match rpl t t line))))
921 (when custom-times
922 (setq line (org-translate-time line)))
923 (cond
924 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
926 ;; a Headline
928 (org-export-generic-check-section "headline")
930 (setq first-heading-pos (or first-heading-pos (point)))
931 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
932 level-offset))
933 txt (match-string 2 line))
934 (org-generic-level-start level old-level txt umax export-plist lines)
935 (setq old-level level))
937 ((and org-export-with-tables
938 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
940 ;; a Table
942 (org-export-generic-check-section "table")
944 (if (not table-open)
945 ;; New table starts
946 (setq table-open t table-buffer nil))
947 ;; Accumulate table lines
948 (setq table-buffer (cons line table-buffer))
949 (when (or (not lines)
950 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
951 (car lines))))
952 (setq table-open nil
953 table-buffer (nreverse table-buffer))
954 (insert (mapconcat
955 (lambda (x)
956 (org-fix-indentation x org-generic-current-indentation))
957 (org-format-table-generic table-buffer)
958 "\n") "\n")))
960 ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)
962 ;; pre-formatted text
964 (setq line (replace-match "\\1" nil nil line))
966 (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf)
968 (insert (format bodyfixedform line)))
970 ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line)
971 ;; if the bullet list item is an asterisk, the leading space is /mandatory/
972 ;; [2010/02/02:rpg]
973 (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line))
975 ;; plain list item
976 ;; TODO: nested lists
978 ;; first add a line break between any previous paragraph or line item and this
979 ;; one
980 (when bodynewline-paragraph
981 (insert bodynewline-paragraph))
983 ;; I believe this gets rid of leading whitespace.
984 (setq line (replace-match "" nil nil line))
986 ;; won't this insert the suffix /before/ the last line of the list?
987 ;; also isn't it spoofed by bulleted lists that have a line skip between the list items
988 ;; unless 'org-empty-line-terminates-plain-lists' is true?
989 (org-export-generic-check-section "liststart" listprefix listsuffix)
991 ;; deal with checkboxes
992 (cond
993 ((string-match "^\\(\\[ \\]\\)[ \t]*" line)
994 (setq line (concat (replace-match listchecktodo nil nil line)
995 listchecktodoend)))
996 ((string-match "^\\(\\[X\\]\\)[ \t]*" line)
997 (setq line (concat (replace-match listcheckdone nil nil line)
998 listcheckdoneend)))
999 ((string-match "^\\(\\[/\\]\\)[ \t]*" line)
1000 (setq line (concat (replace-match listcheckhalf nil nil line)
1001 listcheckhalfend)))
1004 (insert (format listformat (org-export-generic-fontify line))))
1005 ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
1007 ;; numbered list item
1009 ;; TODO: nested lists
1011 (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line))
1013 (org-export-generic-check-section "numliststart"
1014 numlistprefix numlistsuffix)
1016 ;; deal with checkboxes
1017 ;; TODO: whoops; leaving the numbers is a problem for ^ matching
1018 (cond
1019 ((string-match "\\(\\[ \\]\\)[ \t]*" line)
1020 (setq line (concat (replace-match listchecktodo nil nil line)
1021 listchecktodoend)))
1022 ((string-match "\\(\\[X\\]\\)[ \t]*" line)
1023 (setq line (concat (replace-match listcheckdone nil nil line)
1024 listcheckdoneend)))
1025 ((string-match "\\(\\[/\\]\\)[ \t]*" line)
1026 (setq line (concat (replace-match listcheckhalf nil nil line)
1027 listcheckhalfend)))
1030 (insert (format numlistformat (org-export-generic-fontify line))))
1032 ((equal line "ORG-BLOCKQUOTE-START")
1033 (setq line blockquotestart))
1034 ((equal line "ORG-BLOCKQUOTE-END")
1035 (setq line blockquoteend))
1036 ((string-match "^\\s-*$" line)
1037 ;; blank line
1038 (if bodynewline-paragraph
1039 (insert bodynewline-paragraph)))
1042 ;; body
1044 (org-export-generic-check-section "body" bodytextpre bodytextsuf)
1046 (setq line
1047 (org-export-generic-fontify line))
1049 ;; XXX: properties? list?
1050 (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
1051 (setq line (replace-match "\\1\\3:" t nil line)))
1053 (setq line (org-fix-indentation line org-generic-current-indentation))
1055 ;; Remove forced line breaks
1056 (if (string-match "\\\\\\\\[ \t]*$" line)
1057 (setq line (replace-match "" t t line)))
1059 (if bodylinewrap
1060 ;; XXX: was dependent on wrap var which was calculated by???
1061 (if (> (length line) bodylinewrap)
1062 (setq line
1063 (org-export-generic-wrap line bodylinewrap))
1064 (setq line line)))
1065 (insert (format bodylineform line)))))
1067 ;; if we're at a level > 0; insert the closing body level stuff
1068 (let ((counter 0))
1069 (while (> (- level counter) 0)
1070 (insert
1071 (org-export-generic-format export-plist :body-section-suffix 0
1072 (- level counter)))
1073 (setq counter (1+ counter))))
1075 (org-export-generic-check-section "bottom")
1077 (org-export-generic-push-links (nreverse link-buffer))
1079 (normal-mode)
1081 ;; insert the table of contents
1082 (when thetoc
1083 (goto-char (point-min))
1084 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
1085 (progn
1086 (goto-char (match-beginning 0))
1087 (replace-match ""))
1088 (goto-char first-heading-pos))
1089 (mapc 'insert thetoc)
1090 (or (looking-at "[ \t]*\n[ \t]*\n")
1091 (insert "\n\n")))
1093 ;; Convert whitespace place holders
1094 (goto-char (point-min))
1095 (let (beg end)
1096 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1097 (setq end (next-single-property-change beg 'org-whitespace))
1098 (goto-char beg)
1099 (delete-region beg end)
1100 (insert (make-string (- end beg) ?\ ))))
1102 (save-buffer)
1104 ;; remove display and invisible chars
1105 (let (beg end)
1106 (goto-char (point-min))
1107 (while (setq beg (next-single-property-change (point) 'display))
1108 (setq end (next-single-property-change beg 'display))
1109 (delete-region beg end)
1110 (goto-char beg)
1111 (insert "=>"))
1112 (goto-char (point-min))
1113 (while (setq beg (next-single-property-change (point) 'org-cwidth))
1114 (setq end (next-single-property-change beg 'org-cwidth))
1115 (delete-region beg end)
1116 (goto-char beg)))
1117 (goto-char (point-min))))
1120 (defun org-export-generic-format (export-plist prop &optional len n reverse)
1121 "converts a property specification to a string given types of properties
1123 The EXPORT-PLIST should be defined as the lookup plist.
1124 The PROP should be the property name to search for in it.
1125 LEN is set to the length of multi-characters strings to generate (or 0)
1126 N is the tree depth
1127 REVERSE means to reverse the list if the plist match is a list
1129 (let* ((prefixtype (plist-get export-plist prop))
1130 subtype)
1131 (cond
1132 ((null prefixtype) "")
1133 ((and len (char-or-string-p prefixtype) (not (stringp prefixtype)))
1134 ;; sequence of chars
1135 (concat (make-string len prefixtype) "\n"))
1136 ((stringp prefixtype)
1137 prefixtype)
1138 ((and n (listp prefixtype))
1139 (if reverse
1140 (setq prefixtype (reverse prefixtype)))
1141 (setq subtype (if (> n (length prefixtype))
1142 (car (last prefixtype))
1143 (nth (1- n) prefixtype)))
1144 (if (stringp subtype)
1145 subtype
1146 (concat (make-string len subtype) "\n")))
1147 (t ""))
1150 (defun org-export-generic-header (header export-plist
1151 prefixprop formatprop postfixprop
1152 &optional n reverse)
1153 "convert a header to an output string given formatting property names"
1154 (let* ((formatspec (plist-get export-plist formatprop))
1155 (len (length header)))
1156 (concat
1157 (org-export-generic-format export-plist prefixprop len n reverse)
1158 (format (or formatspec "%s") header)
1159 (org-export-generic-format export-plist postfixprop len n reverse))
1162 (defun org-export-generic-preprocess (parameters)
1163 "Do extra work for ASCII export"
1164 ;; Put quotes around verbatim text
1165 (goto-char (point-min))
1166 (while (re-search-forward org-verbatim-re nil t)
1167 (goto-char (match-end 2))
1168 (backward-delete-char 1) (insert "'")
1169 (goto-char (match-beginning 2))
1170 (delete-char 1) (insert "`")
1171 (goto-char (match-end 2)))
1172 ;; Remove target markers
1173 (goto-char (point-min))
1174 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
1175 (replace-match "\\1\\2")))
1177 (defun org-html-expand-for-generic (line)
1178 "Handle quoted HTML for ASCII export."
1179 (if org-export-html-expand
1180 (while (string-match "@<[^<>\n]*>" line)
1181 ;; We just remove the tags for now.
1182 (setq line (replace-match "" nil nil line))))
1183 line)
1185 (defun org-export-generic-wrap (line where)
1186 "Wrap LINE at or before WHERE."
1187 (let* ((ind (org-get-indentation line))
1188 (indstr (make-string ind ?\ ))
1189 (len (length line))
1190 (result "")
1191 pos didfirst)
1192 (while (> len where)
1193 (catch 'found
1194 (loop for i from where downto (/ where 2) do
1195 (and (equal (aref line i) ?\ )
1196 (setq pos i)
1197 (throw 'found t))))
1198 (if pos
1199 (progn
1200 (setq result
1201 (concat result
1202 (if didfirst indstr "")
1203 (substring line 0 pos)
1204 "\n"))
1205 (setq didfirst t)
1206 (setq line (substring line (1+ pos)))
1207 (setq len (length line)))
1208 (setq result (concat result line))
1209 (setq len 0)))
1210 (concat result indstr line)))
1212 (defun org-export-generic-push-links (link-buffer)
1213 "Push out links in the buffer."
1214 (when link-buffer
1215 ;; We still have links to push out.
1216 (insert "\n")
1217 (let ((ind ""))
1218 (save-match-data
1219 (if (save-excursion
1220 (re-search-backward
1221 "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
1222 (setq ind (or (match-string 2)
1223 (make-string (length (match-string 3)) ?\ )))))
1224 (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
1225 link-buffer))
1226 (insert "\n")))
1228 (defun org-generic-level-start (level old-level title umax export-plist
1229 &optional lines)
1230 "Insert a new level in a generic export."
1231 (let ((n (- level umax 1))
1232 (ind 0)
1233 (diff (- level old-level)) (counter 0)
1234 (secnums (plist-get export-plist :body-header-section-numbers))
1235 (secnumformat
1236 (plist-get export-plist :body-header-section-number-format))
1237 char tagstring)
1238 (unless org-export-with-tags
1239 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
1240 (setq title (replace-match "" t t title))))
1242 (cond
1243 ;; going deeper
1244 ((> level old-level)
1245 (while (< (+ old-level counter) (1- level))
1246 (insert
1247 (org-export-generic-format export-plist :body-section-prefix 0
1248 (+ old-level counter)))
1249 (setq counter (1+ counter))
1251 ;; going up
1252 ((< level old-level)
1253 (while (> (- old-level counter) (1- level))
1254 (insert
1255 (org-export-generic-format export-plist :body-section-suffix 0
1256 (- old-level counter)))
1257 (setq counter (1+ counter))
1259 ;; same level
1260 ((= level old-level)
1261 (insert
1262 (org-export-generic-format export-plist :body-section-suffix 0 level))
1265 (insert
1266 (org-export-generic-format export-plist :body-section-prefix 0 level))
1268 (if (and org-export-with-section-numbers
1269 secnums
1270 (or (not (numberp secnums))
1271 (< level secnums)))
1272 (setq title
1273 (concat (format (or secnumformat "%s ")
1274 (org-section-number level)) title)))
1276 ;; handle tags and formatting
1277 (if (string-match
1278 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title)
1279 (progn
1280 (if (plist-get export-plist :body-tags-export)
1281 (setq tagstring (org-export-generic-header (match-string 1 title)
1282 export-plist
1283 :body-tags-prefix
1284 :body-tags-format
1285 :body-tags-suffix)))
1286 (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title)
1287 (setq title (replace-match "" t t title)))
1288 (setq tagstring (plist-get export-plist :body-tags-none-string)))
1290 (insert
1291 (org-export-generic-header title export-plist
1292 :body-section-header-prefix
1293 :body-section-header-format
1294 :body-section-header-suffix
1295 level))
1296 (if tagstring
1297 (insert tagstring))
1299 (setq org-generic-current-indentation '(0 . 0))))
1301 (defun org-insert-centered (s &optional underline)
1302 "Insert the string S centered and underline it with character UNDERLINE."
1303 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
1304 (insert (make-string ind ?\ ) s "\n")
1305 (if underline
1306 (insert (make-string ind ?\ )
1307 (make-string (string-width s) underline)
1308 "\n"))))
1310 (defvar org-table-colgroup-info nil)
1311 (defun org-format-table-generic (lines)
1312 "Format a table for ascii export."
1313 (if (stringp lines)
1314 (setq lines (org-split-string lines "\n")))
1315 (if (not (string-match "^[ \t]*|" (car lines)))
1316 ;; Table made by table.el - test for spanning
1317 lines
1319 ;; A normal org table
1320 ;; Get rid of hlines at beginning and end
1321 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1322 (setq lines (nreverse lines))
1323 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1324 (setq lines (nreverse lines))
1325 (when org-export-table-remove-special-lines
1326 ;; Check if the table has a marking column. If yes remove the
1327 ;; column and the special lines
1328 (setq lines (org-table-clean-before-export lines)))
1329 ;; Get rid of the vertical lines except for grouping
1330 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
1331 rtn line vl1 start)
1332 (while (setq line (pop lines))
1333 (if (string-match org-table-hline-regexp line)
1334 (and (string-match "|\\(.*\\)|" line)
1335 (setq line (replace-match " \\1" t nil line)))
1336 (setq start 0 vl1 vl)
1337 (while (string-match "|" line start)
1338 (setq start (match-end 0))
1339 (or (pop vl1) (setq line (replace-match " " t t line)))))
1340 (push line rtn))
1341 (nreverse rtn))))
1343 (defun org-colgroup-info-to-vline-list (info)
1344 (let (vl new last)
1345 (while info
1346 (setq last new new (pop info))
1347 (if (or (memq last '(:end :startend))
1348 (memq new '(:start :startend)))
1349 (push t vl)
1350 (push nil vl)))
1351 (setq vl (nreverse vl))
1352 (and vl (setcar vl nil))
1353 vl))
1356 ;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
1357 (defvar org-export-generic-emphasis-alist
1358 '(("*" format-boldify nil)
1359 ("/" format-italicize nil)
1360 ("_" format-underline nil)
1361 ("+" format-strikethrough nil)
1362 ("=" format-code t)
1363 ("~" format-verbatim t))
1364 "Alist of org format -> formatting variables for fontification.
1365 Each element of the list is a list of three elements.
1366 The first element is the character used as a marker for fontification.
1367 The second element is a variable name, set in org-export-generic. That
1368 variable will be dereferenced to obtain a formatting string to wrap
1369 fontified text with.
1370 The third element decides whether to protect converted text from other
1371 conversions.")
1373 ;;; Cargo-culted from the latex translation. I couldn't figure out how
1374 ;;; to keep the structure since the generic export operates on lines, rather
1375 ;;; than on a buffer as in the latex export, meaning that none of the
1376 ;;; search forward code could be kept. This led me to rewrite the
1377 ;;; whole thing recursively. A huge lose for efficiency (potentially),
1378 ;;; but I couldn't figure out how to make the looping work.
1379 ;;; Worse, it's /doubly/ recursive, because this function calls
1380 ;;; org-export-generic-emph-format, which can call it recursively...
1381 ;;; [2010/05/20:rpg]
1382 (defun org-export-generic-fontify (string)
1383 "Convert fontification according to generic rules."
1384 (if (string-match org-emph-re string)
1385 ;; The match goes one char after the *string*, except at the end of a line
1386 (let ((emph (assoc (match-string 3 string)
1387 org-export-generic-emphasis-alist))
1388 (beg (match-beginning 0))
1389 (end (match-end 0)))
1390 (unless emph
1391 (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
1392 (match-string 3 string)))
1393 ;; now we need to determine whether we have strikethrough or
1394 ;; a list, which is a bit nasty
1395 (if (and (equal (match-string 3 string) "+")
1396 (save-match-data
1397 (string-match "\\`-+\\'" (match-string 4 string))))
1398 ;; a list --- skip this match and recurse on the point after the
1399 ;; first emph char...
1400 (concat (substring string 0 (1+ (match-beginning 3)))
1401 (org-export-generic-fontify (substring string (match-beginning 3))))
1402 (concat (substring string 0 beg) ;; part before the match
1403 (match-string 1 string)
1404 (org-export-generic-emph-format (second emph)
1405 (match-string 4 string)
1406 (third emph))
1407 (or (match-string 5 string) "")
1408 (org-export-generic-fontify (substring string end)))))
1409 string))
1411 (defun org-export-generic-emph-format (format-varname string protect)
1412 "Return a string that results from applying the markup indicated by
1413 FORMAT-VARNAME to STRING."
1414 (let ((format (symbol-value format-varname)))
1415 (let ((string-to-emphasize
1416 (if protect
1417 string
1418 (org-export-generic-fontify string))))
1419 (if format
1420 (format format string-to-emphasize)
1421 string-to-emphasize))))
1423 (provide 'org-generic)
1424 (provide 'org-export-generic)
1426 ;;; org-export-generic.el ends here