Fixed section-header-prefix for trac wiki.
[org-mode.git] / contrib / lisp / org-export-generic.el
blob5a5af14d79a9894cb054ad765af350b7d1ecbed9
1 ;; org-export-generic.el --- Export frameworg with custom backends
3 ;; Copyright (C) 2009-2011 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 ;; * oh my
91 ;; * optmization (many plist extracts should be in let vars)
92 ;; * define defcustom spec for the specifier list
93 ;; * fonts: at least monospace is not handled at all here.
95 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97 ;;; Commentary:
99 (require 'org-exp)
100 (require 'assoc)
102 (defgroup org-export-generic nil
103 "Options specific for ASCII export of Org-mode files."
104 :tag "Org Export ASCII"
105 :group 'org-export)
107 (defcustom org-export-generic-links-to-notes t
108 "Non-nil means convert links to notes before the next headline.
109 When nil, the link will be exported in place. If the line becomes long
110 in this way, it will be wrapped."
111 :group 'org-export-generic
112 :type 'boolean)
115 (defvar org-generic-current-indentation nil) ; For communication
117 (defvar org-generic-alist
120 ;; generic DEMO exporter
122 ;; (this tries to use every specifier for demo purposes)
124 ("demo"
125 :file-suffix ".txt"
126 :key-binding ?d
128 :header-prefix "<header>\n"
129 :header-suffix "</header>\n"
131 :author-export t
132 :tags-export t
134 :drawers-export t
137 :title-prefix ?=
138 :title-format "<h1>%s</h1>\n"
139 :title-suffix ?=
141 :date-export t
142 :date-prefix "<date>"
143 :date-format "<br /><b>Date:</b> <i>%s</i><br />"
144 :date-suffix "</date>\n\n"
146 :toc-export t
147 :toc-header-prefix "<tocname>\n"
148 :toc-header-format "__%s__\n"
149 :toc-header-suffix "</tocname>\n"
151 :toc-prefix "<toc>\n"
152 :toc-suffix "</toc>\n"
154 :toc-section-numbers t
155 :toc-section-number-format "\#(%s) "
156 :toc-format "--%s--"
157 :toc-format-with-todo "!!%s!!\n"
158 :toc-indent-char ?\
159 :toc-indent-depth 4
161 :toc-tags-export t
162 :toc-tags-prefix " <tags>"
163 :toc-tags-format "*%s*"
164 :toc-tags-suffix "</tags>\n"
165 :toc-tags-none-string "\n"
167 :body-header-section-numbers 3 ; t = all, nil = none
169 ; lists indicate different things per level
170 ; list contents or straight value can either be a
171 ; ?x char reference for printing strings that match the header len
172 ; "" string to print directly
173 :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
174 "<h4>" "<h5>" "<h6>")
175 :body-section-header-format "%s"
176 :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
177 "</h4>\n" "</h5>\n" "</h6>\n")
179 :timestamps-export t
180 :priorities-export t
181 :todo-keywords-export t
183 :body-tags-export t
184 :body-tags-prefix " <tags>"
185 :body-tags-suffix "</tags>\n"
187 ; section prefixes/suffixes can be direct strings or lists as well
188 :body-section-prefix "<secprefix>\n"
189 :body-section-suffix "</secsuffix>\n"
190 ; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
191 ; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
194 ; if preformated text should be included (eg, : prefixed)
195 :body-line-export-preformated t
196 :body-line-fixed-prefix "<pre>\n"
197 :body-line-fixed-suffix "\n</pre>\n"
198 :body-line-fixed-format "%s\n"
201 :body-list-prefix "<list>\n"
202 :body-list-suffix "</list>\n"
203 :body-list-format "<li>%s</li>\n"
205 :body-number-list-prefix "<ol>\n"
206 :body-number-list-suffix "</ol>\n"
207 :body-number-list-format "<li>%s</li>\n"
208 :body-number-list-leave-number t
210 :body-list-checkbox-todo "<checkbox type=\"todo\">"
211 :body-list-checkbox-todo-end "</checkbox (todo)>"
212 :body-list-checkbox-done "<checkbox type=\"done\">"
213 :body-list-checkbox-done-end "</checkbox (done)>"
214 :body-list-checkbox-half "<checkbox type=\"half\">"
215 :body-list-checkbox-half-end "</checkbox (half)>"
220 ; other body lines
221 :body-line-format "%s"
222 :body-line-wrap 60 ; wrap at 60 chars
224 ; print above and below all body parts
225 :body-text-prefix "<p>\n"
226 :body-text-suffix "</p>\n"
231 ;; ascii exporter
233 ;; (close to the original ascii specifier)
235 ("ascii"
236 :file-suffix ".txt"
237 :key-binding ?a
239 :header-prefix ""
240 :header-suffix ""
242 :title-prefix ?=
243 :title-format "%s\n"
244 :title-suffix ?=
246 :date-export t
247 :date-prefix ""
248 :date-format "Date: %s\n"
249 :date-suffix ""
251 :toc-header-prefix ""
252 :toc-header-format "%s\n"
253 :toc-header-suffix ?=
255 :toc-export t
256 :toc-section-numbers t
257 :toc-section-number-format "%s "
258 :toc-format "%s\n"
259 :toc-format-with-todo "%s (*)\n"
260 :toc-indent-char ?\
261 :toc-indent-depth 4
263 :body-header-section-numbers 3
264 :body-section-prefix "\n"
266 ; :body-section-header-prefix "\n"
267 ; :body-section-header-format "%s\n"
268 ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
270 :body-section-header-prefix ("" "" "" "* " " + " " - ")
271 :body-section-header-format "%s\n"
272 :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
274 ; :body-section-marker-prefix ""
275 ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
276 ; :body-section-marker-suffix "\n"
278 :body-line-export-preformated t
279 :body-line-format "%s\n"
280 :body-line-wrap 75
282 ; :body-text-prefix "<t>\n"
283 ; :body-text-suffix "</t>\n"
286 :body-bullet-list-prefix (?* ?+ ?-)
287 ; :body-bullet-list-suffix (?* ?+ ?-)
291 ;; wikipedia
293 ("wikipedia"
294 :file-suffix ".txt"
295 :key-binding ?w
297 :header-prefix ""
298 :header-suffix ""
300 :title-format "= %s =\n"
302 :date-export nil
304 :toc-export nil
306 :body-header-section-numbers nil
307 :body-section-prefix "\n"
309 :body-section-header-prefix ("= " "== " "=== "
310 "==== " "===== " "====== ")
311 :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
312 " ====\n\n" " =====\n\n" " ======\n\n")
314 :body-line-export-preformated t ;; yes/no/maybe???
315 :body-line-format "%s\n"
316 :body-line-wrap 75
318 :body-line-fixed-format " %s\n"
320 :body-list-format "* %s\n"
321 :body-number-list-format "# %s\n"
323 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
326 ;; internet-draft .xml for xml2rfc exporter
328 ("ietfid"
329 ;; this tries to use every specifier for demo purposes
330 :file-suffix ".xml"
331 :key-binding ?i
333 :title-prefix "<?xml version=\"1.0\"\?>
334 <!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [
335 <!ENTITY rfcs PUBLIC '' 'blah'>
336 <?rfc strict=\"yes\" ?>
337 <?rfc toc=\"yes\" ?>
338 <?rfc tocdepth=\"4\" ?>
339 <?rfc symrefs=\"yes\" ?>
340 <?rfc compact=\"yes\" ?>
341 <?rfc subcompact=\"no\" ?>
342 <rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\">
343 <front>
345 :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n"
346 :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\">
347 <organization>Comany, Inc..</organization>
348 <address>
349 <postal>
350 <street></street>
351 <city></city>
352 <region></region>
353 <code></code>
354 <country></country>
355 </postal>
356 <phone></phone>
357 <email></email>
358 </address>
359 </author>
360 <date month=\"FILLMONTH\" year=\"FILLYEAR\"/>
361 <area>Operations and Management</area>
362 <workgroup>FIXME</workgroup>
363 <abstract>\n"
364 :date-export nil
366 :toc-export nil
368 :body-header-section-numbers nil
370 :body-section-header-format "<section title=\"%s\">\n"
371 :body-section-suffix "</section>\n"
373 ; if preformated text should be included (eg, : prefixed)
374 :body-line-export-preformated t
375 :body-line-fixed-prefix "<figure>\n<artwork>\n"
376 :body-line-fixed-suffix "\n</artwork>\n</figure>\n"
378 ; other body lines
379 :body-line-format "%s"
380 :body-line-wrap 75
382 ; print above and below all body parts
383 :body-text-prefix "<t>\n"
384 :body-text-suffix "</t>\n"
386 :body-list-prefix "<list style=\"symbols\">\n"
387 :body-list-suffix "</list>\n"
388 :body-list-format "<t>%s</t>\n"
391 ("trac-wiki"
392 :file-suffix ".txt"
393 :key-binding ?T
395 ;; lifted from wikipedia exporter
396 :header-prefix ""
397 :header-suffix ""
399 :title-format "= %s =\n"
401 :date-export nil
403 :toc-export nil
405 :body-header-section-numbers nil
406 :body-section-prefix "\n"
408 :body-section-header-prefix (" == " " === " " ==== "
409 " ===== " " ====== " " ======= ")
410 :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n"
411 " =====\n\n" " ======\n\n" " =======\n\n")
413 :body-line-export-preformated t ;; yes/no/maybe???
414 :body-line-format "%s\n"
415 :body-line-wrap 75
417 :body-line-fixed-format " %s\n"
419 :body-list-format " * %s\n"
420 :body-number-list-format " # %s\n"
421 ;; :body-list-prefix "LISTSTART"
422 ;; :body-list-suffix "LISTEND"
424 ;; this is ignored! [2010/02/02:rpg]
425 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
427 ("tikiwiki"
428 :file-suffix ".txt"
429 :key-binding ?U
431 ;; lifted from wikipedia exporter
432 :header-prefix ""
433 :header-suffix ""
435 :title-format "-= %s =-\n"
437 :date-export nil
439 :toc-export nil
441 :body-header-section-numbers nil
442 :body-section-prefix "\n"
444 :body-section-header-prefix ("! " "!! " "!!! " "!!!! "
445 "!!!!! " "!!!!!! " "!!!!!!! ")
446 :body-section-header-suffix (" \n" " \n" " \n"
447 " \n" " \n" " \n")
450 :body-line-export-preformated t ;; yes/no/maybe???
451 :body-line-format "%s "
452 :body-line-wrap nil
454 :body-line-fixed-format " %s\n"
456 :body-list-format "* %s\n"
457 :body-number-list-format "# %s\n"
458 ;; :body-list-prefix "LISTSTART"
459 ;; :body-list-suffix "LISTEND"
460 :blockquote-start "\n^\n"
461 :blockquote-end "^\n\n"
462 :body-newline-paragraph "\n"
463 :bold-format "__%s__"
464 :italic-format "''%s''"
465 :underline-format "===%s==="
466 :strikethrough-format "--%s--"
467 :code-format "-+%s+-"
468 :verbatim-format "~pp~%s~/pp~"
471 "A assoc list of property lists to specify export definitions"
474 (setq org-generic-export-type "demo")
476 (defvar org-export-generic-section-type "")
477 (defvar org-export-generic-section-suffix "")
479 ;;;###autoload
480 (defun org-set-generic-type (type definition)
481 "Adds a TYPE and DEFINITION to the existing list of defined generic
482 export definitions."
483 (aput 'org-generic-alist type definition))
485 ;;; helper functions for org-set-generic-type
486 (defvar org-export-generic-keywords nil)
487 (defmacro* def-org-export-generic-keyword (keyword
488 &key documentation
489 type)
490 "Define KEYWORD as a legitimate element for inclusion in
491 the body of an org-set-generic-type definition."
492 `(progn
493 (pushnew ,keyword org-export-generic-keywords)
494 ;; TODO: push the documentation and type information
495 ;; somewhere where it will do us some good.
498 (def-org-export-generic-keyword :body-newline-paragraph
499 :documentation "Bound either to NIL or to a pattern to be
500 inserted in the output for every blank line in the input.
501 The intention is to handle formats where text is flowed, and
502 newlines are interpreted as significant \(e.g., as indicating
503 preformatted text\). A common non-nil value for this keyword
504 is \"\\n\". Should typically be combined with a value for
505 :body-line-format that does NOT end with a newline."
506 :type string)
508 ;;; fontification keywords
509 (def-org-export-generic-keyword :bold-format)
510 (def-org-export-generic-keyword :italic-format)
511 (def-org-export-generic-keyword :underline-format)
512 (def-org-export-generic-keyword :strikethrough-format)
513 (def-org-export-generic-keyword :code-format)
514 (def-org-export-generic-keyword :verbatim-format)
519 (defun org-export-generic-remember-section (type suffix &optional prefix)
520 (setq org-export-generic-section-type type)
521 (setq org-export-generic-section-suffix suffix)
522 (if prefix
523 (insert prefix))
526 (defun org-export-generic-check-section (type &optional prefix suffix)
527 "checks to see if type is already in use, or we're switching parts
528 If we're switching, then insert a potentially previously remembered
529 suffix, and insert the current prefix immediately and then save the
530 suffix a later change time."
532 (when (not (equal type org-export-generic-section-type))
533 (if org-export-generic-section-suffix
534 (insert org-export-generic-section-suffix))
535 (setq org-export-generic-section-type type)
536 (setq org-export-generic-section-suffix suffix)
537 (if prefix
538 (insert prefix))))
540 ;;;###autoload
541 (defun org-export-generic (arg)
542 "Export the outline as generic output.
543 If there is an active region, export only the region.
544 The prefix ARG specifies how many levels of the outline should become
545 underlined headlines. The default is 3."
546 (interactive "P")
547 (setq-default org-todo-line-regexp org-todo-line-regexp)
548 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
549 (org-infile-export-plist)))
550 (region-p (org-region-active-p))
551 (rbeg (and region-p (region-beginning)))
552 (rend (and region-p (region-end)))
553 (subtree-p
554 (when region-p
555 (save-excursion
556 (goto-char rbeg)
557 (and (org-at-heading-p)
558 (>= (org-end-of-subtree t t) rend)))))
559 (level-offset (if subtree-p
560 (save-excursion
561 (goto-char rbeg)
562 (+ (funcall outline-level)
563 (if org-odd-levels-only 1 0)))
565 (opt-plist (setq org-export-opt-plist
566 (if subtree-p
567 (org-export-add-subtree-options opt-plist rbeg)
568 opt-plist)))
570 helpstart
571 (bogus (mapc (lambda (x)
572 (setq helpstart
573 (concat helpstart "\["
574 (char-to-string
575 (plist-get (cdr x) :key-binding))
576 "] " (car x) "\n")))
577 org-generic-alist))
579 (help (concat helpstart "
581 \[ ] the current setting of the org-generic-export-type variable
584 (cmds
586 (append
587 (mapcar (lambda (x)
588 (list
589 (plist-get (cdr x) :key-binding)
590 (car x)))
591 org-generic-alist)
592 (list (list ? "default"))))
594 r1 r2 ass
596 ;; read in the type to use
597 (export-plist
598 (progn
599 (save-excursion
600 (save-window-excursion
601 (delete-other-windows)
602 (with-output-to-temp-buffer "*Org Export/Generic Styles Help*"
603 (princ help))
604 (org-fit-window-to-buffer (get-buffer-window
605 "*Org Export/Generic Styles Help*"))
606 (message "Select command: ")
607 (setq r1 (read-char-exclusive))))
608 (setq r2 (if (< r1 27) (+ r1 96) r1))
609 (unless (setq ass (cadr (assq r2 cmds)))
610 (error "No command associated with key %c" r1))
612 (cdr (assoc
613 (if (equal ass "default") org-generic-export-type ass)
614 org-generic-alist))))
616 (custom-times org-display-custom-times)
617 (org-generic-current-indentation '(0 . 0))
618 (level 0) (old-level 0) line txt lastwastext
619 (umax nil)
620 (umax-toc nil)
621 (case-fold-search nil)
622 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
623 (filesuffix (or (plist-get export-plist :file-suffix) ".foo"))
624 (filename (concat (file-name-as-directory
625 (org-export-directory :ascii opt-plist))
626 (file-name-sans-extension
627 (or (and subtree-p
628 (org-entry-get (region-beginning)
629 "EXPORT_FILE_NAME" t))
630 (file-name-nondirectory bfname)))
631 filesuffix))
632 (filename (if (equal (file-truename filename)
633 (file-truename bfname))
634 (concat filename filesuffix)
635 filename))
636 (buffer (find-file-noselect filename))
637 (org-levels-open (make-vector org-level-max nil))
638 (odd org-odd-levels-only)
639 (date (plist-get opt-plist :date))
640 (author (plist-get opt-plist :author))
641 (title (or (and subtree-p (org-export-get-title-from-subtree))
642 (plist-get opt-plist :title)
643 (and (not
644 (plist-get opt-plist :skip-before-1st-heading))
645 (org-export-grab-title-from-buffer))
646 (file-name-sans-extension
647 (file-name-nondirectory bfname))))
648 (email (plist-get opt-plist :email))
649 (language (plist-get opt-plist :language))
650 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
651 ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
652 (todo nil)
653 (lang-words nil)
654 (region
655 (buffer-substring
656 (if (org-region-active-p) (region-beginning) (point-min))
657 (if (org-region-active-p) (region-end) (point-max))))
658 (org-export-current-backend 'org-export-generic)
659 (lines (org-split-string
660 (org-export-preprocess-string
661 region
662 :for-backend 'ascii
663 :skip-before-1st-heading
664 (plist-get opt-plist :skip-before-1st-heading)
665 :drawers (plist-get export-plist :drawers-export)
666 :tags (plist-get export-plist :tags-export)
667 :priority (plist-get export-plist :priority-export)
668 :footnotes (plist-get export-plist :footnotes-export)
669 :timestamps (plist-get export-plist :timestamps-export)
670 :todo-keywords (plist-get export-plist :todo-keywords-export)
671 :verbatim-multiline t
672 :select-tags (plist-get export-plist :select-tags-export)
673 :exclude-tags (plist-get export-plist :exclude-tags-export)
674 :emph-multiline t
675 :archived-trees
676 (plist-get export-plist :archived-trees-export)
677 :add-text (plist-get opt-plist :text))
678 "\n"))
679 ;; export-generic plist variables
680 (withtags (plist-get export-plist :tags-export))
681 (tagsintoc (plist-get export-plist :toc-tags-export))
682 (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) ""))
683 (tocdepth (plist-get export-plist :toc-indent-depth))
684 (tocindentchar (plist-get export-plist :toc-indent-char))
685 (tocsecnums (plist-get export-plist :toc-section-numbers))
686 (tocsecnumform (plist-get export-plist :toc-section-number-format))
687 (tocformat (plist-get export-plist :toc-format))
688 (tocformtodo (plist-get export-plist :toc-format-with-todo))
689 (tocprefix (plist-get export-plist :toc-prefix))
690 (tocsuffix (plist-get export-plist :toc-suffix))
691 (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix))
692 (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix))
693 (bodyfixedform (or (plist-get export-plist :body-line-fixed-format)
694 "%s"))
695 (listprefix (plist-get export-plist :body-list-prefix))
696 (listsuffix (plist-get export-plist :body-list-suffix))
697 (listformat (or (plist-get export-plist :body-list-format) "%s\n"))
698 (numlistleavenum
699 (plist-get export-plist :body-number-list-leave-number))
700 (numlistprefix (plist-get export-plist :body-number-list-prefix))
701 (numlistsuffix (plist-get export-plist :body-number-list-suffix))
702 (numlistformat
703 (or (plist-get export-plist :body-number-list-format) "%s\n"))
704 (listchecktodo
705 (or (plist-get export-plist :body-list-checkbox-todo) "\\1"))
706 (listcheckdone
707 (or (plist-get export-plist :body-list-checkbox-done) "\\1"))
708 (listcheckhalf
709 (or (plist-get export-plist :body-list-checkbox-half) "\\1"))
710 (listchecktodoend
711 (or (plist-get export-plist :body-list-checkbox-todo-end) ""))
712 (listcheckdoneend
713 (or (plist-get export-plist :body-list-checkbox-done-end) ""))
714 (listcheckhalfend
715 (or (plist-get export-plist :body-list-checkbox-half-end) ""))
716 (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph))
717 (bodytextpre (plist-get export-plist :body-text-prefix))
718 (bodytextsuf (plist-get export-plist :body-text-suffix))
719 (bodylinewrap (plist-get export-plist :body-line-wrap))
720 (bodylineform (or (plist-get export-plist :body-line-format) "%s"))
721 (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
722 (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
724 ;; dynamic variables used heinously in fontification
725 ;; not referenced locally...
726 (format-boldify (plist-get export-plist :bold-format))
727 (format-italicize (plist-get export-plist :italic-format))
728 (format-underline (plist-get export-plist :underline-format))
729 (format-strikethrough (plist-get export-plist :strikethrough-format))
730 (format-code (plist-get export-plist :code-format))
731 (format-verbatim (plist-get export-plist :verbatim-format))
735 thetoc toctags have-headings first-heading-pos
736 table-open table-buffer link-buffer link desc desc0 rpl wrap)
738 (let ((inhibit-read-only t))
739 (org-unmodified
740 (remove-text-properties (point-min) (point-max)
741 '(:org-license-to-kill t))))
743 (setq org-min-level (org-get-min-level lines level-offset))
744 (setq org-last-level org-min-level)
745 (org-init-section-numbers)
747 (find-file-noselect filename)
749 (setq lang-words (or (assoc language org-export-language-setup)
750 (assoc "en" org-export-language-setup)))
751 (switch-to-buffer-other-window buffer)
752 (erase-buffer)
753 (fundamental-mode)
754 ;; create local variables for all options, to make sure all called
755 ;; functions get the correct information
756 (mapc (lambda (x)
757 (set (make-local-variable (nth 2 x))
758 (plist-get opt-plist (car x))))
759 org-export-plist-vars)
760 (org-set-local 'org-odd-levels-only odd)
761 (setq umax (if arg (prefix-numeric-value arg)
762 org-export-headline-levels))
763 (setq umax-toc umax)
765 ;; File header
766 (if title
767 (insert
768 (org-export-generic-header title export-plist
769 :title-prefix
770 :title-format
771 :title-suffix)))
773 (if (and (or author email)
774 (plist-get export-plist :author-export))
775 (insert (concat (nth 1 lang-words) ": " (or author "")
776 (if email (concat " <" email ">") "")
777 "\n")))
779 (cond
780 ((and date (string-match "%" date))
781 (setq date (format-time-string date)))
782 (date)
783 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
785 (if (and date (plist-get export-plist :date-export))
786 (insert
787 (org-export-generic-header date export-plist
788 :date-prefix
789 :date-format
790 :date-suffix)))
792 ;; export the table of contents first
793 (if (plist-get export-plist :toc-export)
794 (progn
795 (push
796 (org-export-generic-header (nth 3 lang-words) export-plist
797 :toc-header-prefix
798 :toc-header-format
799 :toc-header-suffix)
800 thetoc)
802 (if tocprefix
803 (push tocprefix thetoc))
805 (mapc '(lambda (line)
806 (if (string-match org-todo-line-regexp line)
807 ;; This is a headline
808 (progn
809 (setq have-headings t)
810 (setq level (- (match-end 1) (match-beginning 1)
811 level-offset)
812 level (org-tr-level level)
813 txt (match-string 3 line)
814 todo
815 (or (and org-export-mark-todo-in-toc
816 (match-beginning 2)
817 (not (member (match-string 2 line)
818 org-done-keywords)))
819 ; TODO, not DONE
820 (and org-export-mark-todo-in-toc
821 (= level umax-toc)
822 (org-search-todo-below
823 line lines level))))
824 (setq txt (org-html-expand-for-generic txt))
826 (while (string-match org-bracket-link-regexp txt)
827 (setq txt
828 (replace-match
829 (match-string (if (match-end 2) 3 1) txt)
830 t t txt)))
832 (if (and (not tagsintoc)
833 (string-match
834 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
835 txt))
836 (setq txt (replace-match "" t t txt))
837 ; include tags but formated
838 (if (string-match
839 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$")
840 txt)
841 (progn
842 (setq
843 toctags
844 (org-export-generic-header
845 (match-string 1 txt)
846 export-plist :toc-tags-prefix
847 :toc-tags-format :toc-tags-suffix))
848 (string-match
849 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
850 txt)
851 (setq txt (replace-match "" t t txt)))
852 (setq toctags tocnotagsstr)))
854 (if (string-match quote-re0 txt)
855 (setq txt (replace-match "" t t txt)))
857 (if (<= level umax-toc)
858 (progn
859 (push
860 (concat
862 (make-string
863 (* (max 0 (- level org-min-level)) tocdepth)
864 tocindentchar)
866 (if tocsecnums
867 (format tocsecnumform
868 (org-section-number level))
871 (format
872 (if todo tocformtodo tocformat)
873 txt)
875 toctags)
877 thetoc)
878 (setq org-last-level level))
879 ))))
880 lines)
881 (if tocsuffix
882 (push tocsuffix thetoc))
883 (setq thetoc (if have-headings (nreverse thetoc) nil))))
885 (org-init-section-numbers)
886 (org-export-generic-check-section "top")
887 (while (setq line (pop lines))
888 (when (and link-buffer (string-match org-outline-regexp-bol line))
889 (org-export-generic-push-links (nreverse link-buffer))
890 (setq link-buffer nil))
891 (setq wrap nil)
892 ;; Remove the quoted HTML tags.
893 ;; XXX
894 (setq line (org-html-expand-for-generic line))
895 ;; Replace links with the description when possible
896 ;; XXX
897 (while (string-match org-bracket-link-regexp line)
898 (setq link (match-string 1 line)
899 desc0 (match-string 3 line)
900 desc (or desc0 (match-string 1 line)))
901 (if (and (> (length link) 8)
902 (equal (substring link 0 8) "coderef:"))
903 (setq line (replace-match
904 (format (org-export-get-coderef-format (substring link 8) desc)
905 (cdr (assoc
906 (substring link 8)
907 org-export-code-refs)))
908 t t line))
909 (setq rpl (concat "["
910 (or (match-string 3 line) (match-string 1 line))
911 "]"))
912 (when (and desc0 (not (equal desc0 link)))
913 (if org-export-generic-links-to-notes
914 (push (cons desc0 link) link-buffer)
915 (setq rpl (concat rpl " (" link ")")
916 wrap (+ (length line) (- (length (match-string 0 line)))
917 (length desc)))))
918 (setq line (replace-match rpl t t line))))
919 (when custom-times
920 (setq line (org-translate-time line)))
921 (cond
922 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
924 ;; a Headline
926 (org-export-generic-check-section "headline")
928 (setq first-heading-pos (or first-heading-pos (point)))
929 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
930 level-offset))
931 txt (match-string 2 line))
932 (org-generic-level-start level old-level txt umax export-plist lines)
933 (setq old-level level))
935 ((and org-export-with-tables
936 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
938 ;; a Table
940 (org-export-generic-check-section "table")
942 (if (not table-open)
943 ;; New table starts
944 (setq table-open t table-buffer nil))
945 ;; Accumulate table lines
946 (setq table-buffer (cons line table-buffer))
947 (when (or (not lines)
948 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
949 (car lines))))
950 (setq table-open nil
951 table-buffer (nreverse table-buffer))
952 (insert (mapconcat
953 (lambda (x)
954 (org-fix-indentation x org-generic-current-indentation))
955 (org-format-table-generic table-buffer)
956 "\n") "\n")))
958 ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)
960 ;; pre-formatted text
962 (setq line (replace-match "\\1" nil nil line))
964 (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf)
966 (insert (format bodyfixedform line)))
968 ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line)
969 ;; if the bullet list item is an asterisk, the leading space is /mandatory/
970 ;; [2010/02/02:rpg]
971 (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line))
973 ;; plain list item
974 ;; TODO: nested lists
976 ;; first add a line break between any previous paragraph or line item and this
977 ;; one
978 (when bodynewline-paragraph
979 (insert bodynewline-paragraph))
981 ;; I believe this gets rid of leading whitespace.
982 (setq line (replace-match "" nil nil line))
984 ;; won't this insert the suffix /before/ the last line of the list?
985 ;; also isn't it spoofed by bulleted lists that have a line skip between the list items
986 ;; unless 'org-empty-line-terminates-plain-lists' is true?
987 (org-export-generic-check-section "liststart" listprefix listsuffix)
989 ;; deal with checkboxes
990 (cond
991 ((string-match "^\\(\\[ \\]\\)[ \t]*" line)
992 (setq line (concat (replace-match listchecktodo nil nil line)
993 listchecktodoend)))
994 ((string-match "^\\(\\[X\\]\\)[ \t]*" line)
995 (setq line (concat (replace-match listcheckdone nil nil line)
996 listcheckdoneend)))
997 ((string-match "^\\(\\[/\\]\\)[ \t]*" line)
998 (setq line (concat (replace-match listcheckhalf nil nil line)
999 listcheckhalfend)))
1002 (insert (format listformat (org-export-generic-fontify line))))
1003 ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
1005 ;; numbered list item
1007 ;; TODO: nested lists
1009 (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line))
1011 (org-export-generic-check-section "numliststart"
1012 numlistprefix numlistsuffix)
1014 ;; deal with checkboxes
1015 ;; TODO: whoops; leaving the numbers is a problem for ^ matching
1016 (cond
1017 ((string-match "\\(\\[ \\]\\)[ \t]*" line)
1018 (setq line (concat (replace-match listchecktodo nil nil line)
1019 listchecktodoend)))
1020 ((string-match "\\(\\[X\\]\\)[ \t]*" line)
1021 (setq line (concat (replace-match listcheckdone nil nil line)
1022 listcheckdoneend)))
1023 ((string-match "\\(\\[/\\]\\)[ \t]*" line)
1024 (setq line (concat (replace-match listcheckhalf nil nil line)
1025 listcheckhalfend)))
1028 (insert (format numlistformat (org-export-generic-fontify line))))
1030 ((equal line "ORG-BLOCKQUOTE-START")
1031 (setq line blockquotestart))
1032 ((equal line "ORG-BLOCKQUOTE-END")
1033 (setq line blockquoteend))
1034 ((string-match "^\\s-*$" line)
1035 ;; blank line
1036 (if bodynewline-paragraph
1037 (insert bodynewline-paragraph)))
1040 ;; body
1042 (org-export-generic-check-section "body" bodytextpre bodytextsuf)
1044 (setq line
1045 (org-export-generic-fontify line))
1047 ;; XXX: properties? list?
1048 (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
1049 (setq line (replace-match "\\1\\3:" t nil line)))
1051 (setq line (org-fix-indentation line org-generic-current-indentation))
1053 ;; Remove forced line breaks
1054 (if (string-match "\\\\\\\\[ \t]*$" line)
1055 (setq line (replace-match "" t t line)))
1057 (if bodylinewrap
1058 ;; XXX: was dependent on wrap var which was calculated by???
1059 (if (> (length line) bodylinewrap)
1060 (setq line
1061 (org-export-generic-wrap line bodylinewrap))
1062 (setq line line)))
1063 (insert (format bodylineform line)))))
1065 ;; if we're at a level > 0; insert the closing body level stuff
1066 (let ((counter 0))
1067 (while (> (- level counter) 0)
1068 (insert
1069 (org-export-generic-format export-plist :body-section-suffix 0
1070 (- level counter)))
1071 (setq counter (1+ counter))))
1073 (org-export-generic-check-section "bottom")
1075 (org-export-generic-push-links (nreverse link-buffer))
1077 (normal-mode)
1079 ;; insert the table of contents
1080 (when thetoc
1081 (goto-char (point-min))
1082 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
1083 (progn
1084 (goto-char (match-beginning 0))
1085 (replace-match ""))
1086 (goto-char first-heading-pos))
1087 (mapc 'insert thetoc)
1088 (or (looking-at "[ \t]*\n[ \t]*\n")
1089 (insert "\n\n")))
1091 ;; Convert whitespace place holders
1092 (goto-char (point-min))
1093 (let (beg end)
1094 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1095 (setq end (next-single-property-change beg 'org-whitespace))
1096 (goto-char beg)
1097 (delete-region beg end)
1098 (insert (make-string (- end beg) ?\ ))))
1100 (save-buffer)
1102 ;; remove display and invisible chars
1103 (let (beg end)
1104 (goto-char (point-min))
1105 (while (setq beg (next-single-property-change (point) 'display))
1106 (setq end (next-single-property-change beg 'display))
1107 (delete-region beg end)
1108 (goto-char beg)
1109 (insert "=>"))
1110 (goto-char (point-min))
1111 (while (setq beg (next-single-property-change (point) 'org-cwidth))
1112 (setq end (next-single-property-change beg 'org-cwidth))
1113 (delete-region beg end)
1114 (goto-char beg)))
1115 (goto-char (point-min))))
1118 (defun org-export-generic-format (export-plist prop &optional len n reverse)
1119 "converts a property specification to a string given types of properties
1121 The EXPORT-PLIST should be defined as the lookup plist.
1122 The PROP should be the property name to search for in it.
1123 LEN is set to the length of multi-characters strings to generate (or 0)
1124 N is the tree depth
1125 REVERSE means to reverse the list if the plist match is a list
1127 (let* ((prefixtype (plist-get export-plist prop))
1128 subtype)
1129 (cond
1130 ((null prefixtype) "")
1131 ((and len (char-or-string-p prefixtype) (not (stringp prefixtype)))
1132 ;; sequence of chars
1133 (concat (make-string len prefixtype) "\n"))
1134 ((stringp prefixtype)
1135 prefixtype)
1136 ((and n (listp prefixtype))
1137 (if reverse
1138 (setq prefixtype (reverse prefixtype)))
1139 (setq subtype (if (> n (length prefixtype))
1140 (car (last prefixtype))
1141 (nth (1- n) prefixtype)))
1142 (if (stringp subtype)
1143 subtype
1144 (concat (make-string len subtype) "\n")))
1145 (t ""))
1148 (defun org-export-generic-header (header export-plist
1149 prefixprop formatprop postfixprop
1150 &optional n reverse)
1151 "convert a header to an output string given formatting property names"
1152 (let* ((formatspec (plist-get export-plist formatprop))
1153 (len (length header)))
1154 (concat
1155 (org-export-generic-format export-plist prefixprop len n reverse)
1156 (format (or formatspec "%s") header)
1157 (org-export-generic-format export-plist postfixprop len n reverse))
1160 (defun org-export-generic-preprocess (parameters)
1161 "Do extra work for ASCII export"
1162 ;; Put quotes around verbatim text
1163 (goto-char (point-min))
1164 (while (re-search-forward org-verbatim-re nil t)
1165 (goto-char (match-end 2))
1166 (backward-delete-char 1) (insert "'")
1167 (goto-char (match-beginning 2))
1168 (delete-char 1) (insert "`")
1169 (goto-char (match-end 2)))
1170 ;; Remove target markers
1171 (goto-char (point-min))
1172 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
1173 (replace-match "\\1\\2")))
1175 (defun org-html-expand-for-generic (line)
1176 "Handle quoted HTML for ASCII export."
1177 (if org-export-html-expand
1178 (while (string-match "@<[^<>\n]*>" line)
1179 ;; We just remove the tags for now.
1180 (setq line (replace-match "" nil nil line))))
1181 line)
1183 (defun org-export-generic-wrap (line where)
1184 "Wrap LINE at or before WHERE."
1185 (let* ((ind (org-get-indentation line))
1186 (indstr (make-string ind ?\ ))
1187 (len (length line))
1188 (result "")
1189 pos didfirst)
1190 (while (> len where)
1191 (catch 'found
1192 (loop for i from where downto (/ where 2) do
1193 (and (equal (aref line i) ?\ )
1194 (setq pos i)
1195 (throw 'found t))))
1196 (if pos
1197 (progn
1198 (setq result
1199 (concat result
1200 (if didfirst indstr "")
1201 (substring line 0 pos)
1202 "\n"))
1203 (setq didfirst t)
1204 (setq line (substring line (1+ pos)))
1205 (setq len (length line)))
1206 (setq result (concat result line))
1207 (setq len 0)))
1208 (concat result indstr line)))
1210 (defun org-export-generic-push-links (link-buffer)
1211 "Push out links in the buffer."
1212 (when link-buffer
1213 ;; We still have links to push out.
1214 (insert "\n")
1215 (let ((ind ""))
1216 (save-match-data
1217 (if (save-excursion
1218 (re-search-backward
1219 "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
1220 (setq ind (or (match-string 2)
1221 (make-string (length (match-string 3)) ?\ )))))
1222 (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
1223 link-buffer))
1224 (insert "\n")))
1226 (defun org-generic-level-start (level old-level title umax export-plist
1227 &optional lines)
1228 "Insert a new level in a generic export."
1229 (let ((n (- level umax 1))
1230 (ind 0)
1231 (diff (- level old-level)) (counter 0)
1232 (secnums (plist-get export-plist :body-header-section-numbers))
1233 (secnumformat
1234 (plist-get export-plist :body-header-section-number-format))
1235 char tagstring)
1236 (unless org-export-with-tags
1237 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
1238 (setq title (replace-match "" t t title))))
1240 (cond
1241 ;; going deeper
1242 ((> level old-level)
1243 (while (< (+ old-level counter) (1- level))
1244 (insert
1245 (org-export-generic-format export-plist :body-section-prefix 0
1246 (+ old-level counter)))
1247 (setq counter (1+ counter))
1249 ;; going up
1250 ((< level old-level)
1251 (while (> (- old-level counter) (1- level))
1252 (insert
1253 (org-export-generic-format export-plist :body-section-suffix 0
1254 (- old-level counter)))
1255 (setq counter (1+ counter))
1257 ;; same level
1258 ((= level old-level)
1259 (insert
1260 (org-export-generic-format export-plist :body-section-suffix 0 level))
1263 (insert
1264 (org-export-generic-format export-plist :body-section-prefix 0 level))
1266 (if (and org-export-with-section-numbers
1267 secnums
1268 (or (not (numberp secnums))
1269 (< level secnums)))
1270 (setq title
1271 (concat (format (or secnumformat "%s ")
1272 (org-section-number level)) title)))
1274 ;; handle tags and formatting
1275 (if (string-match
1276 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title)
1277 (progn
1278 (if (plist-get export-plist :body-tags-export)
1279 (setq tagstring (org-export-generic-header (match-string 1 title)
1280 export-plist
1281 :body-tags-prefix
1282 :body-tags-format
1283 :body-tags-suffix)))
1284 (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title)
1285 (setq title (replace-match "" t t title)))
1286 (setq tagstring (plist-get export-plist :body-tags-none-string)))
1288 (insert
1289 (org-export-generic-header title export-plist
1290 :body-section-header-prefix
1291 :body-section-header-format
1292 :body-section-header-suffix
1293 level))
1294 (if tagstring
1295 (insert tagstring))
1297 (setq org-generic-current-indentation '(0 . 0))))
1299 (defun org-insert-centered (s &optional underline)
1300 "Insert the string S centered and underline it with character UNDERLINE."
1301 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
1302 (insert (make-string ind ?\ ) s "\n")
1303 (if underline
1304 (insert (make-string ind ?\ )
1305 (make-string (string-width s) underline)
1306 "\n"))))
1308 (defvar org-table-colgroup-info nil)
1309 (defun org-format-table-generic (lines)
1310 "Format a table for ascii export."
1311 (if (stringp lines)
1312 (setq lines (org-split-string lines "\n")))
1313 (if (not (string-match "^[ \t]*|" (car lines)))
1314 ;; Table made by table.el - test for spanning
1315 lines
1317 ;; A normal org table
1318 ;; Get rid of hlines at beginning and end
1319 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1320 (setq lines (nreverse lines))
1321 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1322 (setq lines (nreverse lines))
1323 (when org-export-table-remove-special-lines
1324 ;; Check if the table has a marking column. If yes remove the
1325 ;; column and the special lines
1326 (setq lines (org-table-clean-before-export lines)))
1327 ;; Get rid of the vertical lines except for grouping
1328 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
1329 rtn line vl1 start)
1330 (while (setq line (pop lines))
1331 (if (string-match org-table-hline-regexp line)
1332 (and (string-match "|\\(.*\\)|" line)
1333 (setq line (replace-match " \\1" t nil line)))
1334 (setq start 0 vl1 vl)
1335 (while (string-match "|" line start)
1336 (setq start (match-end 0))
1337 (or (pop vl1) (setq line (replace-match " " t t line)))))
1338 (push line rtn))
1339 (nreverse rtn))))
1341 (defun org-colgroup-info-to-vline-list (info)
1342 (let (vl new last)
1343 (while info
1344 (setq last new new (pop info))
1345 (if (or (memq last '(:end :startend))
1346 (memq new '(:start :startend)))
1347 (push t vl)
1348 (push nil vl)))
1349 (setq vl (nreverse vl))
1350 (and vl (setcar vl nil))
1351 vl))
1354 ;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
1355 (defvar org-export-generic-emphasis-alist
1356 '(("*" format-boldify nil)
1357 ("/" format-italicize nil)
1358 ("_" format-underline nil)
1359 ("+" format-strikethrough nil)
1360 ("=" format-code t)
1361 ("~" format-verbatim t))
1362 "Alist of org format -> formatting variables for fontification.
1363 Each element of the list is a list of three elements.
1364 The first element is the character used as a marker for fontification.
1365 The second element is a variable name, set in org-export-generic. That
1366 variable will be dereferenced to obtain a formatting string to wrap
1367 fontified text with.
1368 The third element decides whether to protect converted text from other
1369 conversions.")
1371 ;;; Cargo-culted from the latex translation. I couldn't figure out how
1372 ;;; to keep the structure since the generic export operates on lines, rather
1373 ;;; than on a buffer as in the latex export, meaning that none of the
1374 ;;; search forward code could be kept. This led me to rewrite the
1375 ;;; whole thing recursively. A huge lose for efficiency (potentially),
1376 ;;; but I couldn't figure out how to make the looping work.
1377 ;;; Worse, it's /doubly/ recursive, because this function calls
1378 ;;; org-export-generic-emph-format, which can call it recursively...
1379 ;;; [2010/05/20:rpg]
1380 (defun org-export-generic-fontify (string)
1381 "Convert fontification according to generic rules."
1382 (if (string-match org-emph-re string)
1383 ;; The match goes one char after the *string*, except at the end of a line
1384 (let ((emph (assoc (match-string 3 string)
1385 org-export-generic-emphasis-alist))
1386 (beg (match-beginning 0))
1387 (end (match-end 0)))
1388 (unless emph
1389 (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
1390 (match-string 3 string)))
1391 ;; now we need to determine whether we have strikethrough or
1392 ;; a list, which is a bit nasty
1393 (if (and (equal (match-string 3 string) "+")
1394 (save-match-data
1395 (string-match "\\`-+\\'" (match-string 4 string))))
1396 ;; a list --- skip this match and recurse on the point after the
1397 ;; first emph char...
1398 (concat (substring string 0 (1+ (match-beginning 3)))
1399 (org-export-generic-fontify (substring string (match-beginning 3))))
1400 (concat (substring string 0 beg) ;; part before the match
1401 (match-string 1 string)
1402 (org-export-generic-emph-format (second emph)
1403 (match-string 4 string)
1404 (third emph))
1405 (or (match-string 5 string) "")
1406 (org-export-generic-fontify (substring string end)))))
1407 string))
1409 (defun org-export-generic-emph-format (format-varname string protect)
1410 "Return a string that results from applying the markup indicated by
1411 FORMAT-VARNAME to STRING."
1412 (let ((format (symbol-value format-varname)))
1413 (let ((string-to-emphasize
1414 (if protect
1415 string
1416 (org-export-generic-fontify string))))
1417 (if format
1418 (format format string-to-emphasize)
1419 string-to-emphasize))))
1421 (provide 'org-generic)
1422 (provide 'org-export-generic)
1424 ;;; org-export-generic.el ends here