Merge branch 'maint'
[org-mode.git] / contrib / lisp / org-export-generic.el
blob104019887b4e04cd1187542f78ad836dd6d8c69f
1 ;; org-export-generic.el --- Export frameworg with custom backends
3 ;; Copyright (C) 2009-2013 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 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 ;; IMPORTANT: IF YOU WANT TO WRITE A NEW EXPORTER FOR ORG, PLEASE
31 ;; CHECK contrib/lisp/org-export.el -- ORG-EXPORT-GENERIC.EL, WHILE
32 ;; STILL USEFUL, SHOULD NOT BE USED FOR NEW EXPORTERS.
34 ;; org-export-generic is basically a simple translation system that
35 ;; knows how to parse at least most of a .org buffer and then add
36 ;; various formatting prefixes before and after each section type. It
37 ;; does this by examining a property list stored in org-generic-alist.
38 ;; You can dynamically add propety lists of your own using the
39 ;; org-set-generic-type function:
41 ;; (org-set-generic-type
42 ;; "really-basic-text"
43 ;; '(:file-suffix ".txt"
44 ;; :key-binding ?R
46 ;; :title-format "=== %s ===\n"
47 ;; :body-header-section-numbers t
48 ;; :body-header-section-number-format "%s) "
49 ;; :body-section-header-prefix "\n"
50 ;; :body-section-header-suffix "\n"
51 ;; :body-line-format " %s\n"
52 ;; :body-line-wrap 75
53 ;; ))
55 ;; Note: Upper case key-bindings are reserved for your use. Lower
56 ;; case key bindings may conflict with future export-generic
57 ;; publications.
59 ;; Then run org-export (ctrl-c ctrl-e) and select generic or run
60 ;; org-export-generic. You'll then be prompted with a list of export
61 ;; types to choose from which will include your new type assigned to
62 ;; the key "r".
64 ;; ----------------------------------------------------------------------
66 ;; TODO (non-ordered)
67 ;; * handle function references
68 ;; * handle other types of multi-complex-listy-things to do
69 ;; ideas: (t ?- "%s" ?-)
70 ;; * handle indent specifiers better
71 ;; ideas: (4 ?\ "%s")
72 ;; * need flag to remove indents from body text
73 ;; * handle links
74 ;; * handle internationalization strings better
75 ;; * date/author/etc needs improvment (internationalization too)
76 ;; * allow specifying of section ordering
77 ;; ideas: :ordering ("header" "toc" "body" "footer")
78 ;; ^ matches current hard coded ordering
79 ;; * err, actually *do* a footer
80 ;; * deal with usage of org globals
81 ;; *** should we even consider them, or let the per-section specifiers do it
82 ;; *** answer: remove; mostly removed now
83 ;; * deal with interactive support for picking a export specifier label
84 ;; * char specifiers that need extra length because of formatting
85 ;; idea: (?- 4) for 4-longer
86 ;; * centering specifier
87 ;; idea: ('center " -- %s -- ")
88 ;; * remove more of the unneeded export-to-ascii copy code
89 ;; * tags
90 ;; *** supported now, but need separate format per tag
91 ;; *** allow different open/closing prefixes
92 ;; * properties
93 ;; * drawers
94 ;; * Escape camel-case for wiki exporters.
95 ;; * Adjust to depth limits on headers --- need to roll-over from headers
96 ;; to lists, as per other exporters
97 ;; * optmization (many plist extracts should be in let vars)
98 ;; * define defcustom spec for the specifier list
99 ;; * fonts: at least monospace is not handled at all here.
101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103 ;;; Commentary:
105 (require 'org-exp)
106 (require 'assoc)
107 (eval-when-compile (require 'cl))
109 (defgroup org-export-generic nil
110 "Options specific for ASCII export of Org-mode files."
111 :tag "Org Export ASCII"
112 :group 'org-export)
114 (defcustom org-export-generic-links-to-notes t
115 "Non-nil means convert links to notes before the next headline.
116 When nil, the link will be exported in place. If the line becomes long
117 in this way, it will be wrapped."
118 :group 'org-export-generic
119 :type 'boolean)
122 (defvar org-generic-current-indentation nil) ; For communication
124 (defvar org-generic-alist
127 ;; generic DEMO exporter
129 ;; (this tries to use every specifier for demo purposes)
131 ("demo"
132 :file-suffix ".txt"
133 :key-binding ?d
135 :header-prefix "<header>\n"
136 :header-suffix "</header>\n"
138 :author-export t
139 :tags-export t
141 :drawers-export t
144 :title-prefix ?=
145 :title-format "<h1>%s</h1>\n"
146 :title-suffix ?=
148 :date-export t
149 :date-prefix "<date>"
150 :date-format "<br /><b>Date:</b> <i>%s</i><br />"
151 :date-suffix "</date>\n\n"
153 :toc-export t
154 :toc-header-prefix "<tocname>\n"
155 :toc-header-format "__%s__\n"
156 :toc-header-suffix "</tocname>\n"
158 :toc-prefix "<toc>\n"
159 :toc-suffix "</toc>\n"
161 :toc-section-numbers t
162 :toc-section-number-format "\#(%s) "
163 :toc-format "--%s--"
164 :toc-format-with-todo "!!%s!!\n"
165 :toc-indent-char ?\
166 :toc-indent-depth 4
168 :toc-tags-export t
169 :toc-tags-prefix " <tags>"
170 :toc-tags-format "*%s*"
171 :toc-tags-suffix "</tags>\n"
172 :toc-tags-none-string "\n"
174 :body-header-section-numbers 3 ; t = all, nil = none
176 ; lists indicate different things per level
177 ; list contents or straight value can either be a
178 ; ?x char reference for printing strings that match the header len
179 ; "" string to print directly
180 :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
181 "<h4>" "<h5>" "<h6>")
182 :body-section-header-format "%s"
183 :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
184 "</h4>\n" "</h5>\n" "</h6>\n")
186 :timestamps-export t
187 :priorities-export t
188 :todo-keywords-export t
190 :body-tags-export t
191 :body-tags-prefix " <tags>"
192 :body-tags-suffix "</tags>\n"
194 ; section prefixes/suffixes can be direct strings or lists as well
195 :body-section-prefix "<secprefix>\n"
196 :body-section-suffix "</secsuffix>\n"
197 ; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
198 ; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
201 ; if preformated text should be included (eg, : prefixed)
202 :body-line-export-preformated t
203 :body-line-fixed-prefix "<pre>\n"
204 :body-line-fixed-suffix "\n</pre>\n"
205 :body-line-fixed-format "%s\n"
208 :body-list-prefix "<list>\n"
209 :body-list-suffix "</list>\n"
210 :body-list-format "<li>%s</li>\n"
212 :body-number-list-prefix "<ol>\n"
213 :body-number-list-suffix "</ol>\n"
214 :body-number-list-format "<li>%s</li>\n"
215 :body-number-list-leave-number t
217 :body-list-checkbox-todo "<checkbox type=\"todo\">"
218 :body-list-checkbox-todo-end "</checkbox (todo)>"
219 :body-list-checkbox-done "<checkbox type=\"done\">"
220 :body-list-checkbox-done-end "</checkbox (done)>"
221 :body-list-checkbox-half "<checkbox type=\"half\">"
222 :body-list-checkbox-half-end "</checkbox (half)>"
227 ; other body lines
228 :body-line-format "%s"
229 :body-line-wrap 60 ; wrap at 60 chars
231 ; print above and below all body parts
232 :body-text-prefix "<p>\n"
233 :body-text-suffix "</p>\n")
235 ;; ascii exporter
237 ;; (close to the original ascii specifier)
239 ("ascii"
240 :file-suffix ".txt"
241 :key-binding ?a
243 :header-prefix ""
244 :header-suffix ""
246 :title-prefix ?=
247 :title-format "%s\n"
248 :title-suffix ?=
250 :date-export t
251 :date-prefix ""
252 :date-format "Date: %s\n"
253 :date-suffix ""
255 :toc-header-prefix ""
256 :toc-header-format "%s\n"
257 :toc-header-suffix ?=
259 :toc-export t
260 :toc-section-numbers t
261 :toc-section-number-format "%s "
262 :toc-format "%s\n"
263 :toc-format-with-todo "%s (*)\n"
264 :toc-indent-char ?\
265 :toc-indent-depth 4
267 :body-header-section-numbers 3
268 :body-section-prefix "\n"
270 ; :body-section-header-prefix "\n"
271 ; :body-section-header-format "%s\n"
272 ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
274 :body-section-header-prefix ("" "" "" "* " " + " " - ")
275 :body-section-header-format "%s\n"
276 :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
278 ; :body-section-marker-prefix ""
279 ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
280 ; :body-section-marker-suffix "\n"
282 :body-line-export-preformated t
283 :body-line-format "%s\n"
284 :body-line-wrap 75
286 ; :body-text-prefix "<t>\n"
287 ; :body-text-suffix "</t>\n"
290 :body-bullet-list-prefix (?* ?+ ?-))
291 ; :body-bullet-list-suffix (?* ?+ ?-)
294 ;; wikipedia
296 ("wikipedia"
297 :file-suffix ".txt"
298 :key-binding ?w
300 :header-prefix ""
301 :header-suffix ""
303 :title-format "= %s =\n"
305 :date-export nil
307 :toc-export nil
309 :body-header-section-numbers nil
310 :body-section-prefix "\n"
312 :body-section-header-prefix ("= " "== " "=== "
313 "==== " "===== " "====== ")
314 :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
315 " ====\n\n" " =====\n\n" " ======\n\n")
317 :body-line-export-preformated t ;; yes/no/maybe???
318 :body-line-format "%s\n"
319 :body-line-wrap 75
321 :body-line-fixed-format " %s\n"
323 :body-list-format "* %s\n"
324 :body-number-list-format "# %s\n"
326 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** "))
328 ;; mediawiki
330 ("mediawiki"
331 :file-suffix ".txt"
332 :key-binding ?m
334 :header-prefix ""
335 :header-suffix ""
337 :title-format "= %s =\n"
339 :date-export nil
341 :toc-export nil
343 :body-header-section-numbers nil
344 :body-section-prefix "\n"
346 :body-section-header-prefix ("= " "== " "=== "
347 "==== " "===== " "====== ")
348 :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
349 " ====\n\n" " =====\n\n" " ======\n\n")
351 :body-line-export-preformated t ;; yes/no/maybe???
352 :body-line-format "%s\n"
353 :body-line-wrap 75
355 :body-line-fixed-format " %s\n"
357 :body-list-format "* %s\n"
358 :body-number-list-format "# %s\n"
360 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
361 :body-list-checkbox-todo "&#9744; "
362 :body-list-checkbox-done "&#9746; "
363 :body-table-start "{|"
364 :body-table-end "|}"
365 :body-table-cell-start "|"
366 :body-table-cell-end "\n"
367 :body-table-last-cell-end "|-"
368 :body-table-hline-start "")
370 ;; internet-draft .xml for xml2rfc exporter
372 ("ietfid"
373 ;; this tries to use every specifier for demo purposes
374 :file-suffix ".xml"
375 :key-binding ?i
377 :title-prefix "<?xml version=\"1.0\"\?>
378 <!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [
379 <!ENTITY rfcs PUBLIC '' 'blah'>
380 <?rfc strict=\"yes\" ?>
381 <?rfc toc=\"yes\" ?>
382 <?rfc tocdepth=\"4\" ?>
383 <?rfc symrefs=\"yes\" ?>
384 <?rfc compact=\"yes\" ?>
385 <?rfc subcompact=\"no\" ?>
386 <rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\">
387 <front>
389 :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n"
390 :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\">
391 <organization>Comany, Inc..</organization>
392 <address>
393 <postal>
394 <street></street>
395 <city></city>
396 <region></region>
397 <code></code>
398 <country></country>
399 </postal>
400 <phone></phone>
401 <email></email>
402 </address>
403 </author>
404 <date month=\"FILLMONTH\" year=\"FILLYEAR\"/>
405 <area>Operations and Management</area>
406 <workgroup>FIXME</workgroup>
407 <abstract>\n"
408 :date-export nil
410 :toc-export nil
412 :body-header-section-numbers nil
414 :body-section-header-format "<section title=\"%s\">\n"
415 :body-section-suffix "</section>\n"
417 ; if preformated text should be included (eg, : prefixed)
418 :body-line-export-preformated t
419 :body-line-fixed-prefix "<figure>\n<artwork>\n"
420 :body-line-fixed-suffix "\n</artwork>\n</figure>\n"
422 ; other body lines
423 :body-line-format "%s"
424 :body-line-wrap 75
426 ; print above and below all body parts
427 :body-text-prefix "<t>\n"
428 :body-text-suffix "</t>\n"
430 :body-list-prefix "<list style=\"symbols\">\n"
431 :body-list-suffix "</list>\n"
432 :body-list-format "<t>%s</t>\n")
433 ("trac-wiki"
434 :file-suffix ".txt"
435 :key-binding ?T
437 ;; lifted from wikipedia exporter
438 :header-prefix ""
439 :header-suffix ""
441 :title-format "= %s =\n"
443 :date-export nil
445 :toc-export nil
447 :body-header-section-numbers nil
448 :body-section-prefix "\n"
450 :body-section-header-prefix (" == " " === " " ==== "
451 " ===== " )
452 :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n"
453 " =====\n\n" " ======\n\n" " =======\n\n")
455 :body-line-export-preformated t ;; yes/no/maybe???
456 :body-line-format "%s\n"
457 :body-line-wrap 75
459 :body-line-fixed-format " %s\n"
461 :body-list-format " * %s\n"
462 :body-number-list-format " # %s\n"
463 ;; :body-list-prefix "LISTSTART"
464 ;; :body-list-suffix "LISTEND"
466 ;; this is ignored! [2010/02/02:rpg]
467 :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** "))
468 ("tikiwiki"
469 :file-suffix ".txt"
470 :key-binding ?U
472 ;; lifted from wikipedia exporter
473 :header-prefix ""
474 :header-suffix ""
476 :title-format "-= %s =-\n"
478 :date-export nil
480 :toc-export nil
482 :body-header-section-numbers nil
483 :body-section-prefix "\n"
485 :body-section-header-prefix ("! " "!! " "!!! " "!!!! "
486 "!!!!! " "!!!!!! " "!!!!!!! ")
487 :body-section-header-suffix (" \n" " \n" " \n"
488 " \n" " \n" " \n")
491 :body-line-export-preformated t ;; yes/no/maybe???
492 :body-line-format "%s "
493 :body-line-wrap nil
495 :body-line-fixed-format " %s\n"
497 :body-list-format "* %s\n"
498 :body-number-list-format "# %s\n"
499 ;; :body-list-prefix "LISTSTART"
500 ;; :body-list-suffix "LISTEND"
501 :blockquote-start "\n^\n"
502 :blockquote-end "^\n\n"
503 :body-newline-paragraph "\n"
504 :bold-format "__%s__"
505 :italic-format "''%s''"
506 :underline-format "===%s==="
507 :strikethrough-format "--%s--"
508 :code-format "-+%s+-"
509 :verbatim-format "~pp~%s~/pp~"))
510 "A assoc list of property lists to specify export definitions")
512 (setq org-generic-export-type "demo")
514 (defvar org-export-generic-section-type "")
515 (defvar org-export-generic-section-suffix "")
517 ;;;###autoload
518 (defun org-set-generic-type (type definition)
519 "Adds a TYPE and DEFINITION to the existing list of defined generic
520 export definitions."
521 (aput 'org-generic-alist type definition))
523 ;;; helper functions for org-set-generic-type
524 (defvar org-export-generic-keywords nil)
525 (defmacro* def-org-export-generic-keyword (keyword
526 &key documentation
527 type)
528 "Define KEYWORD as a legitimate element for inclusion in
529 the body of an org-set-generic-type definition."
530 ;; TODO: push the documentation and type information
531 ;; somewhere where it will do us some good.
532 `(progn
533 (pushnew ,keyword org-export-generic-keywords)))
535 (def-org-export-generic-keyword :body-newline-paragraph
536 :documentation "Bound either to NIL or to a pattern to be
537 inserted in the output for every blank line in the input.
538 The intention is to handle formats where text is flowed, and
539 newlines are interpreted as significant \(e.g., as indicating
540 preformatted text\). A common non-nil value for this keyword
541 is \"\\n\". Should typically be combined with a value for
542 :body-line-format that does NOT end with a newline."
543 :type string)
545 ;;; fontification keywords
546 (def-org-export-generic-keyword :bold-format)
547 (def-org-export-generic-keyword :italic-format)
548 (def-org-export-generic-keyword :underline-format)
549 (def-org-export-generic-keyword :strikethrough-format)
550 (def-org-export-generic-keyword :code-format)
551 (def-org-export-generic-keyword :verbatim-format)
553 (defun org-export-generic-remember-section (type suffix &optional prefix)
554 (setq org-export-generic-section-type type)
555 (setq org-export-generic-section-suffix suffix)
556 (if prefix
557 (insert prefix)))
559 (defun org-export-generic-check-section (type &optional prefix suffix)
560 "checks to see if type is already in use, or we're switching parts
561 If we're switching, then insert a potentially previously remembered
562 suffix, and insert the current prefix immediately and then save the
563 suffix a later change time."
565 (when (not (equal type org-export-generic-section-type))
566 (if org-export-generic-section-suffix
567 (insert org-export-generic-section-suffix))
568 (setq org-export-generic-section-type type)
569 (setq org-export-generic-section-suffix suffix)
570 (if prefix
571 (insert prefix))))
573 ;;;###autoload
574 (defun org-export-generic (arg)
575 "Export the outline as generic output.
576 If there is an active region, export only the region.
577 The prefix ARG specifies how many levels of the outline should become
578 underlined headlines. The default is 3."
579 (interactive "P")
580 (setq-default org-todo-line-regexp org-todo-line-regexp)
581 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
582 (org-infile-export-plist)))
583 (region-p (org-region-active-p))
584 (rbeg (and region-p (region-beginning)))
585 (rend (and region-p (region-end)))
586 (subtree-p
587 (when region-p
588 (save-excursion
589 (goto-char rbeg)
590 (and (org-at-heading-p)
591 (>= (org-end-of-subtree t t) rend)))))
592 (level-offset (if subtree-p
593 (save-excursion
594 (goto-char rbeg)
595 (+ (funcall outline-level)
596 (if org-odd-levels-only 1 0)))
598 (opt-plist (setq org-export-opt-plist
599 (if subtree-p
600 (org-export-add-subtree-options opt-plist rbeg)
601 opt-plist)))
603 helpstart
604 (bogus (mapc (lambda (x)
605 (setq helpstart
606 (concat helpstart "\["
607 (char-to-string
608 (plist-get (cdr x) :key-binding))
609 "] " (car x) "\n")))
610 org-generic-alist))
612 (help (concat helpstart "
614 \[ ] the current setting of the org-generic-export-type variable
617 (cmds
619 (append
620 (mapcar (lambda (x)
621 (list
622 (plist-get (cdr x) :key-binding)
623 (car x)))
624 org-generic-alist)
625 (list (list ? "default"))))
627 r1 r2 ass
629 ;; read in the type to use
630 (export-plist
631 (progn
632 (save-excursion
633 (save-window-excursion
634 (delete-other-windows)
635 (with-output-to-temp-buffer "*Org Export/Generic Styles Help*"
636 (princ help))
637 (org-fit-window-to-buffer (get-buffer-window
638 "*Org Export/Generic Styles Help*"))
639 (message "Select command: ")
640 (setq r1 (read-char-exclusive))))
641 (setq r2 (if (< r1 27) (+ r1 96) r1))
642 (unless (setq ass (cadr (assq r2 cmds)))
643 (error "No command associated with key %c" r1))
645 (cdr (assoc
646 (if (equal ass "default") org-generic-export-type ass)
647 org-generic-alist))))
649 (custom-times org-display-custom-times)
650 (org-generic-current-indentation '(0 . 0))
651 (level 0) (old-level 0) line txt lastwastext
652 (umax nil)
653 (umax-toc nil)
654 (case-fold-search nil)
655 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
656 (filesuffix (or (plist-get export-plist :file-suffix) ".foo"))
657 (filename (concat (file-name-as-directory
658 (org-export-directory :ascii opt-plist))
659 (file-name-sans-extension
660 (or (and subtree-p
661 (org-entry-get (region-beginning)
662 "EXPORT_FILE_NAME" t))
663 (file-name-nondirectory bfname)))
664 filesuffix))
665 (filename (if (equal (file-truename filename)
666 (file-truename bfname))
667 (concat filename filesuffix)
668 filename))
669 (buffer (find-file-noselect filename))
670 (org-levels-open (make-vector org-level-max nil))
671 (odd org-odd-levels-only)
672 (date (plist-get opt-plist :date))
673 (author (plist-get opt-plist :author))
674 (title (or (and subtree-p (org-export-get-title-from-subtree))
675 (plist-get opt-plist :title)
676 (and (not
677 (plist-get opt-plist :skip-before-1st-heading))
678 (org-export-grab-title-from-buffer))
679 (file-name-sans-extension
680 (file-name-nondirectory bfname))))
681 (email (plist-get opt-plist :email))
682 (language (plist-get opt-plist :language))
683 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
684 ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
685 (todo nil)
686 (lang-words nil)
687 (region
688 (buffer-substring
689 (if (org-region-active-p) (region-beginning) (point-min))
690 (if (org-region-active-p) (region-end) (point-max))))
691 (org-export-current-backend 'org-export-generic)
692 (lines (org-split-string
693 (org-export-preprocess-string
694 region
695 :for-backend 'ascii
696 :skip-before-1st-heading
697 (plist-get opt-plist :skip-before-1st-heading)
698 :drawers (plist-get export-plist :drawers-export)
699 :tags (plist-get export-plist :tags-export)
700 :priority (plist-get export-plist :priority-export)
701 :footnotes (plist-get export-plist :footnotes-export)
702 :timestamps (plist-get export-plist :timestamps-export)
703 :todo-keywords (plist-get export-plist :todo-keywords-export)
704 :verbatim-multiline t
705 :select-tags (plist-get export-plist :select-tags-export)
706 :exclude-tags (plist-get export-plist :exclude-tags-export)
707 :emph-multiline t
708 :archived-trees
709 (plist-get export-plist :archived-trees-export)
710 :add-text (plist-get opt-plist :text))
711 "\n"))
712 ;; export-generic plist variables
713 (withtags (plist-get export-plist :tags-export))
714 (tagsintoc (plist-get export-plist :toc-tags-export))
715 (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) ""))
716 (tocdepth (plist-get export-plist :toc-indent-depth))
717 (tocindentchar (plist-get export-plist :toc-indent-char))
718 (tocsecnums (plist-get export-plist :toc-section-numbers))
719 (tocsecnumform (plist-get export-plist :toc-section-number-format))
720 (tocformat (plist-get export-plist :toc-format))
721 (tocformtodo (plist-get export-plist :toc-format-with-todo))
722 (tocprefix (plist-get export-plist :toc-prefix))
723 (tocsuffix (plist-get export-plist :toc-suffix))
724 (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix))
725 (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix))
726 (bodyfixedform (or (plist-get export-plist :body-line-fixed-format)
727 "%s"))
728 (listprefix (plist-get export-plist :body-list-prefix))
729 (listsuffix (plist-get export-plist :body-list-suffix))
730 (listformat (or (plist-get export-plist :body-list-format) "%s\n"))
731 (numlistleavenum
732 (plist-get export-plist :body-number-list-leave-number))
733 (numlistprefix (plist-get export-plist :body-number-list-prefix))
734 (numlistsuffix (plist-get export-plist :body-number-list-suffix))
735 (numlistformat
736 (or (plist-get export-plist :body-number-list-format) "%s\n"))
737 (listchecktodo
738 (or (plist-get export-plist :body-list-checkbox-todo) "\\1"))
739 (listcheckdone
740 (or (plist-get export-plist :body-list-checkbox-done) "\\1"))
741 (listcheckhalf
742 (or (plist-get export-plist :body-list-checkbox-half) "\\1"))
743 (listchecktodoend
744 (or (plist-get export-plist :body-list-checkbox-todo-end) ""))
745 (listcheckdoneend
746 (or (plist-get export-plist :body-list-checkbox-done-end) ""))
747 (listcheckhalfend
748 (or (plist-get export-plist :body-list-checkbox-half-end) ""))
749 (bodytablestart
750 (or (plist-get export-plist :body-table-start) ""))
751 (bodytableend
752 (or (plist-get export-plist :body-table-end) ""))
753 (bodytablerowstart
754 (or (plist-get export-plist :body-table-row-start) ""))
755 (bodytablerowend
756 (or (plist-get export-plist :body-table-row-end) ""))
757 (bodytablecellstart
758 (or (plist-get export-plist :body-table-cell-start) ""))
759 (bodytablecellend
760 (or (plist-get export-plist :body-table-cell-end) ""))
761 (bodytablefirstcellstart
762 (or (plist-get export-plist :body-table-first-cell-start) ""))
763 (bodytableinteriorcellstart
764 (or (plist-get export-plist :body-table-interior-cell-start) ""))
765 (bodytableinteriorcellend
766 (or (plist-get export-plist :body-table-interior-cell-end) ""))
767 (bodytablelastcellend
768 (or (plist-get export-plist :body-table-last-cell-end) ""))
769 (bodytablehlinestart
770 (or (plist-get export-plist :body-table-hline-start) " \\1"))
771 (bodytablehlineend
772 (or (plist-get export-plist :body-table-hline-end) ""))
776 (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph))
777 (bodytextpre (plist-get export-plist :body-text-prefix))
778 (bodytextsuf (plist-get export-plist :body-text-suffix))
779 (bodylinewrap (plist-get export-plist :body-line-wrap))
780 (bodylineform (or (plist-get export-plist :body-line-format) "%s"))
781 (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
782 (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
784 ;; dynamic variables used heinously in fontification
785 ;; not referenced locally...
786 (format-boldify (plist-get export-plist :bold-format))
787 (format-italicize (plist-get export-plist :italic-format))
788 (format-underline (plist-get export-plist :underline-format))
789 (format-strikethrough (plist-get export-plist :strikethrough-format))
790 (format-code (plist-get export-plist :code-format))
791 (format-verbatim (plist-get export-plist :verbatim-format))
795 thetoc toctags have-headings first-heading-pos
796 table-open table-buffer link-buffer link desc desc0 rpl wrap)
798 (let ((inhibit-read-only t))
799 (org-unmodified
800 (remove-text-properties (point-min) (point-max)
801 '(:org-license-to-kill t))))
803 (setq org-min-level (org-get-min-level lines level-offset))
804 (setq org-last-level org-min-level)
805 (org-init-section-numbers)
807 (find-file-noselect filename)
809 (setq lang-words (or (assoc language org-export-language-setup)
810 (assoc "en" org-export-language-setup)))
811 (switch-to-buffer-other-window buffer)
812 (erase-buffer)
813 (fundamental-mode)
814 ;; create local variables for all options, to make sure all called
815 ;; functions get the correct information
816 (mapc (lambda (x)
817 (set (make-local-variable (nth 2 x))
818 (plist-get opt-plist (car x))))
819 org-export-plist-vars)
820 (org-set-local 'org-odd-levels-only odd)
821 (setq umax (if arg (prefix-numeric-value arg)
822 org-export-headline-levels))
823 (setq umax-toc umax)
825 ;; File header
826 (if title
827 (insert
828 (org-export-generic-header title export-plist
829 :title-prefix
830 :title-format
831 :title-suffix)))
833 (if (and (or author email)
834 (plist-get export-plist :author-export))
835 (insert (concat (nth 1 lang-words) ": " (or author "")
836 (if email (concat " <" email ">") "")
837 "\n")))
839 (cond
840 ((and date (string-match "%" date))
841 (setq date (format-time-string date)))
842 (date)
843 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
845 (if (and date (plist-get export-plist :date-export))
846 (insert
847 (org-export-generic-header date export-plist
848 :date-prefix
849 :date-format
850 :date-suffix)))
852 ;; export the table of contents first
853 (if (plist-get export-plist :toc-export)
854 (progn
855 (push
856 (org-export-generic-header (nth 3 lang-words) export-plist
857 :toc-header-prefix
858 :toc-header-format
859 :toc-header-suffix)
860 thetoc)
862 (if tocprefix
863 (push tocprefix thetoc))
865 (mapc #'(lambda (line)
866 (if (string-match org-todo-line-regexp line)
867 ;; This is a headline
868 (progn
869 (setq have-headings t)
870 (setq level (- (match-end 1) (match-beginning 1)
871 level-offset)
872 level (org-tr-level level)
873 txt (match-string 3 line)
874 todo
875 (or (and org-export-mark-todo-in-toc
876 (match-beginning 2)
877 (not (member (match-string 2 line)
878 org-done-keywords)))
879 ; TODO, not DONE
880 (and org-export-mark-todo-in-toc
881 (= level umax-toc)
882 (org-search-todo-below
883 line lines level))))
884 (setq txt (org-html-expand-for-generic txt))
886 (while (string-match org-bracket-link-regexp txt)
887 (setq txt
888 (replace-match
889 (match-string (if (match-end 2) 3 1) txt)
890 t t txt)))
892 (if (and (not tagsintoc)
893 (string-match
894 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
895 txt))
896 (setq txt (replace-match "" t t txt))
897 ; include tags but formated
898 (if (string-match
899 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$")
900 txt)
901 (progn
902 (setq
903 toctags
904 (org-export-generic-header
905 (match-string 1 txt)
906 export-plist :toc-tags-prefix
907 :toc-tags-format :toc-tags-suffix))
908 (string-match
909 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
910 txt)
911 (setq txt (replace-match "" t t txt)))
912 (setq toctags tocnotagsstr)))
914 (if (string-match quote-re0 txt)
915 (setq txt (replace-match "" t t txt)))
917 (if (<= level umax-toc)
918 (progn
919 (push
920 (concat
922 (make-string
923 (* (max 0 (- level org-min-level)) tocdepth)
924 tocindentchar)
926 (if tocsecnums
927 (format tocsecnumform
928 (org-section-number level))
931 (format
932 (if todo tocformtodo tocformat)
933 txt)
935 toctags)
937 thetoc)
938 (setq org-last-level level))))))
939 lines)
940 (if tocsuffix
941 (push tocsuffix thetoc))
942 (setq thetoc (if have-headings (nreverse thetoc) nil))))
944 (org-init-section-numbers)
945 (org-export-generic-check-section "top")
946 (while (setq line (pop lines))
947 (when (and link-buffer (string-match org-outline-regexp-bol line))
948 (org-export-generic-push-links (nreverse link-buffer))
949 (setq link-buffer nil))
950 (setq wrap nil)
951 ;; Remove the quoted HTML tags.
952 ;; XXX
953 (setq line (org-html-expand-for-generic line))
954 ;; Replace links with the description when possible
955 ;; XXX
956 (while (string-match org-bracket-link-regexp line)
957 (setq link (match-string 1 line)
958 desc0 (match-string 3 line)
959 desc (or desc0 (match-string 1 line)))
960 (if (and (> (length link) 8)
961 (equal (substring link 0 8) "coderef:"))
962 (setq line (replace-match
963 (format (org-export-get-coderef-format (substring link 8) desc)
964 (cdr (assoc
965 (substring link 8)
966 org-export-code-refs)))
967 t t line))
968 (setq rpl (concat "["
969 (or (match-string 3 line) (match-string 1 line))
970 "]"))
971 (when (and desc0 (not (equal desc0 link)))
972 (if org-export-generic-links-to-notes
973 (push (cons desc0 link) link-buffer)
974 (setq rpl (concat rpl " (" link ")")
975 wrap (+ (length line) (- (length (match-string 0 line)))
976 (length desc)))))
977 (setq line (replace-match rpl t t line))))
978 (when custom-times
979 (setq line (org-translate-time line)))
980 (cond
981 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
983 ;; a Headline
985 (org-export-generic-check-section "headline")
987 (setq first-heading-pos (or first-heading-pos (point)))
988 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
989 level-offset))
990 txt (match-string 2 line))
991 (org-generic-level-start level old-level txt umax export-plist lines)
992 (setq old-level level))
994 ((and org-export-with-tables
995 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
997 ;; a Table
999 (org-export-generic-check-section "table")
1001 (if (not table-open)
1002 ;; New table starts
1003 (setq table-open t table-buffer nil))
1004 ;; Accumulate table lines
1005 (setq table-buffer (cons line table-buffer))
1006 (when (or (not lines)
1007 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1008 (car lines))))
1009 (setq table-open nil
1010 table-buffer (nreverse table-buffer))
1011 (insert (mapconcat
1012 (lambda (x)
1013 (org-fix-indentation x org-generic-current-indentation))
1014 (org-format-table-generic table-buffer)
1015 "\n") "\n")))
1017 ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)
1019 ;; pre-formatted text
1021 (setq line (replace-match "\\1" nil nil line))
1023 (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf)
1025 (insert (format bodyfixedform line)))
1027 ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line)
1028 ;; if the bullet list item is an asterisk, the leading space is /mandatory/
1029 ;; [2010/02/02:rpg]
1030 (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line))
1032 ;; plain list item
1033 ;; TODO: nested lists
1035 ;; first add a line break between any previous paragraph or line item and this
1036 ;; one
1037 (when bodynewline-paragraph
1038 (insert bodynewline-paragraph))
1040 ;; I believe this gets rid of leading whitespace.
1041 (setq line (replace-match "" nil nil line))
1043 ;; won't this insert the suffix /before/ the last line of the list?
1044 ;; also isn't it spoofed by bulleted lists that have a line skip between the list items
1045 ;; unless 'org-empty-line-terminates-plain-lists' is true?
1046 (org-export-generic-check-section "liststart" listprefix listsuffix)
1048 ;; deal with checkboxes
1049 (cond
1050 ((string-match "^\\(\\[ \\]\\)[ \t]*" line)
1051 (setq line (concat (replace-match listchecktodo nil nil line)
1052 listchecktodoend)))
1053 ((string-match "^\\(\\[X\\]\\)[ \t]*" line)
1054 (setq line (concat (replace-match listcheckdone nil nil line)
1055 listcheckdoneend)))
1056 ((string-match "^\\(\\[/\\]\\)[ \t]*" line)
1057 (setq line (concat (replace-match listcheckhalf nil nil line)
1058 listcheckhalfend))))
1060 (insert (format listformat (org-export-generic-fontify line))))
1061 ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
1063 ;; numbered list item
1065 ;; TODO: nested lists
1067 (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line))
1069 (org-export-generic-check-section "numliststart"
1070 numlistprefix numlistsuffix)
1072 ;; deal with checkboxes
1073 ;; TODO: whoops; leaving the numbers is a problem for ^ matching
1074 (cond
1075 ((string-match "\\(\\[ \\]\\)[ \t]*" line)
1076 (setq line (concat (replace-match listchecktodo nil nil line)
1077 listchecktodoend)))
1078 ((string-match "\\(\\[X\\]\\)[ \t]*" line)
1079 (setq line (concat (replace-match listcheckdone nil nil line)
1080 listcheckdoneend)))
1081 ((string-match "\\(\\[/\\]\\)[ \t]*" line)
1082 (setq line (concat (replace-match listcheckhalf nil nil line)
1083 listcheckhalfend))))
1085 (insert (format numlistformat (org-export-generic-fontify line))))
1087 ((equal line "ORG-BLOCKQUOTE-START")
1088 (setq line blockquotestart))
1089 ((equal line "ORG-BLOCKQUOTE-END")
1090 (setq line blockquoteend))
1091 ((string-match "^\\s-*$" line)
1092 ;; blank line
1093 (if bodynewline-paragraph
1094 (insert bodynewline-paragraph)))
1097 ;; body
1099 (org-export-generic-check-section "body" bodytextpre bodytextsuf)
1101 (setq line
1102 (org-export-generic-fontify line))
1104 ;; XXX: properties? list?
1105 (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
1106 (setq line (replace-match "\\1\\3:" t nil line)))
1108 (setq line (org-fix-indentation line org-generic-current-indentation))
1110 ;; Remove forced line breaks
1111 (if (string-match "\\\\\\\\[ \t]*$" line)
1112 (setq line (replace-match "" t t line)))
1114 (if bodylinewrap
1115 ;; XXX: was dependent on wrap var which was calculated by???
1116 (if (> (length line) bodylinewrap)
1117 (setq line
1118 (org-export-generic-wrap line bodylinewrap))
1119 (setq line line)))
1120 (insert (format bodylineform line)))))
1122 ;; if we're at a level > 0; insert the closing body level stuff
1123 (let ((counter 0))
1124 (while (> (- level counter) 0)
1125 (insert
1126 (org-export-generic-format export-plist :body-section-suffix 0
1127 (- level counter)))
1128 (setq counter (1+ counter))))
1130 (org-export-generic-check-section "bottom")
1132 (org-export-generic-push-links (nreverse link-buffer))
1134 (normal-mode)
1136 ;; insert the table of contents
1137 (when thetoc
1138 (goto-char (point-min))
1139 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
1140 (progn
1141 (goto-char (match-beginning 0))
1142 (replace-match ""))
1143 (goto-char first-heading-pos))
1144 (mapc 'insert thetoc)
1145 (or (looking-at "[ \t]*\n[ \t]*\n")
1146 (insert "\n\n")))
1148 ;; Convert whitespace place holders
1149 (goto-char (point-min))
1150 (let (beg end)
1151 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1152 (setq end (next-single-property-change beg 'org-whitespace))
1153 (goto-char beg)
1154 (delete-region beg end)
1155 (insert (make-string (- end beg) ?\ ))))
1157 (save-buffer)
1159 ;; remove display and invisible chars
1160 (let (beg end)
1161 (goto-char (point-min))
1162 (while (setq beg (next-single-property-change (point) 'display))
1163 (setq end (next-single-property-change beg 'display))
1164 (delete-region beg end)
1165 (goto-char beg)
1166 (insert "=>"))
1167 (goto-char (point-min))
1168 (while (setq beg (next-single-property-change (point) 'org-cwidth))
1169 (setq end (next-single-property-change beg 'org-cwidth))
1170 (delete-region beg end)
1171 (goto-char beg)))
1172 (goto-char (point-min))))
1175 (defun org-export-generic-format (export-plist prop &optional len n reverse)
1176 "converts a property specification to a string given types of properties
1178 The EXPORT-PLIST should be defined as the lookup plist.
1179 The PROP should be the property name to search for in it.
1180 LEN is set to the length of multi-characters strings to generate (or 0)
1181 N is the tree depth
1182 REVERSE means to reverse the list if the plist match is a list
1184 (let* ((prefixtype (plist-get export-plist prop))
1185 subtype)
1186 (cond
1187 ((null prefixtype) "")
1188 ((and len (char-or-string-p prefixtype) (not (stringp prefixtype)))
1189 ;; sequence of chars
1190 (concat (make-string len prefixtype) "\n"))
1191 ((stringp prefixtype)
1192 prefixtype)
1193 ((and n (listp prefixtype))
1194 (if reverse
1195 (setq prefixtype (reverse prefixtype)))
1196 (setq subtype (if (> n (length prefixtype))
1197 (car (last prefixtype))
1198 (nth (1- n) prefixtype)))
1199 (if (stringp subtype)
1200 subtype
1201 (concat (make-string len subtype) "\n")))
1202 (t ""))))
1204 (defun org-export-generic-header (header export-plist
1205 prefixprop formatprop postfixprop
1206 &optional n reverse)
1207 "convert a header to an output string given formatting property names"
1208 (let* ((formatspec (plist-get export-plist formatprop))
1209 (len (length header)))
1210 (concat
1211 (org-export-generic-format export-plist prefixprop len n reverse)
1212 (format (or formatspec "%s") header)
1213 (org-export-generic-format export-plist postfixprop len n reverse))))
1215 (defun org-export-generic-preprocess (parameters)
1216 "Do extra work for ASCII export"
1217 ;; Put quotes around verbatim text
1218 (goto-char (point-min))
1219 (while (re-search-forward org-verbatim-re nil t)
1220 (goto-char (match-end 2))
1221 (delete-backward-char 1) (insert "'")
1222 (goto-char (match-beginning 2))
1223 (delete-char 1) (insert "`")
1224 (goto-char (match-end 2)))
1225 ;; Remove target markers
1226 (goto-char (point-min))
1227 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
1228 (replace-match "\\1\\2")))
1230 (defun org-html-expand-for-generic (line)
1231 "Handle quoted HTML for ASCII export."
1232 (if org-export-html-expand
1233 (while (string-match "@<[^<>\n]*>" line)
1234 ;; We just remove the tags for now.
1235 (setq line (replace-match "" nil nil line))))
1236 line)
1238 (defun org-export-generic-wrap (line where)
1239 "Wrap LINE at or before WHERE."
1240 (let* ((ind (org-get-indentation line))
1241 (indstr (make-string ind ?\ ))
1242 (len (length line))
1243 (result "")
1244 pos didfirst)
1245 (while (> len where)
1246 (catch 'found
1247 (loop for i from where downto (/ where 2) do
1248 (and (equal (aref line i) ?\ )
1249 (setq pos i)
1250 (throw 'found t))))
1251 (if pos
1252 (progn
1253 (setq result
1254 (concat result
1255 (if didfirst indstr "")
1256 (substring line 0 pos)
1257 "\n"))
1258 (setq didfirst t)
1259 (setq line (substring line (1+ pos)))
1260 (setq len (length line)))
1261 (setq result (concat result line))
1262 (setq len 0)))
1263 (concat result indstr line)))
1265 (defun org-export-generic-push-links (link-buffer)
1266 "Push out links in the buffer."
1267 (when link-buffer
1268 ;; We still have links to push out.
1269 (insert "\n")
1270 (let ((ind ""))
1271 (save-match-data
1272 (if (save-excursion
1273 (re-search-backward
1274 "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
1275 (setq ind (or (match-string 2)
1276 (make-string (length (match-string 3)) ?\ )))))
1277 (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
1278 link-buffer))
1279 (insert "\n")))
1281 (defun org-generic-level-start (level old-level title umax export-plist
1282 &optional lines)
1283 "Insert a new level in a generic export."
1284 (let ((n (- level umax 1))
1285 (ind 0)
1286 (diff (- level old-level)) (counter 0)
1287 (secnums (plist-get export-plist :body-header-section-numbers))
1288 (secnumformat
1289 (plist-get export-plist :body-header-section-number-format))
1290 char tagstring)
1291 (unless org-export-with-tags
1292 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
1293 (setq title (replace-match "" t t title))))
1295 (cond
1296 ;; going deeper
1297 ((> level old-level)
1298 (while (< (+ old-level counter) (1- level))
1299 (insert
1300 (org-export-generic-format export-plist :body-section-prefix 0
1301 (+ old-level counter)))
1302 (setq counter (1+ counter))))
1303 ;; going up
1304 ((< level old-level)
1305 (while (> (- old-level counter) (1- level))
1306 (insert
1307 (org-export-generic-format export-plist :body-section-suffix 0
1308 (- old-level counter)))
1309 (setq counter (1+ counter))))
1310 ;; same level
1311 ((= level old-level)
1312 (insert
1313 (org-export-generic-format export-plist :body-section-suffix 0 level))))
1314 (insert
1315 (org-export-generic-format export-plist :body-section-prefix 0 level))
1317 (if (and org-export-with-section-numbers
1318 secnums
1319 (or (not (numberp secnums))
1320 (< level secnums)))
1321 (setq title
1322 (concat (format (or secnumformat "%s ")
1323 (org-section-number level)) title)))
1325 ;; handle tags and formatting
1326 (if (string-match
1327 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title)
1328 (progn
1329 (if (plist-get export-plist :body-tags-export)
1330 (setq tagstring (org-export-generic-header (match-string 1 title)
1331 export-plist
1332 :body-tags-prefix
1333 :body-tags-format
1334 :body-tags-suffix)))
1335 (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title)
1336 (setq title (replace-match "" t t title)))
1337 (setq tagstring (plist-get export-plist :body-tags-none-string)))
1339 (insert
1340 (org-export-generic-header title export-plist
1341 :body-section-header-prefix
1342 :body-section-header-format
1343 :body-section-header-suffix
1344 level))
1345 (if tagstring
1346 (insert tagstring))
1348 (setq org-generic-current-indentation '(0 . 0))))
1350 (defun org-insert-centered (s &optional underline)
1351 "Insert the string S centered and underline it with character UNDERLINE."
1352 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
1353 (insert (make-string ind ?\ ) s "\n")
1354 (if underline
1355 (insert (make-string ind ?\ )
1356 (make-string (string-width s) underline)
1357 "\n"))))
1359 (defvar org-table-colgroup-info nil)
1360 (defun org-format-table-generic (lines)
1361 "Format a table for ascii export."
1362 (if (stringp lines)
1363 (setq lines (org-split-string lines "\n")))
1364 (if (not (string-match "^[ \t]*|" (car lines)))
1365 ;; Table made by table.el - test for spanning
1366 lines
1368 ;; A normal org table
1369 ;; Get rid of hlines at beginning and end
1370 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1371 (setq lines (nreverse lines))
1372 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1373 (setq lines (nreverse lines))
1374 (when org-export-table-remove-special-lines
1375 ;; Check if the table has a marking column. If yes remove the
1376 ;; column and the special lines
1377 (setq lines (org-table-clean-before-export lines)))
1378 ;; Get rid of the vertical lines except for grouping
1379 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
1380 (rtn (list bodytablestart)) line vl1 start)
1381 (while (setq line (pop lines))
1382 (setq line (concat bodytablerowstart line))
1383 (if (string-match org-table-hline-regexp line)
1384 (and (string-match "|\\(.*\\)|" line)
1385 (setq line (replace-match (concat bodytablehlinestart bodytablehlineend) t nil line)))
1386 (setq start 0 vl1 vl)
1387 (if (string-match "|\\(.*\\)|" line)
1388 (setq line (replace-match (concat bodytablefirstcellstart bodytablecellstart " \\1 " bodytablecellend bodytablelastcellend) t nil line)))
1389 (while (string-match "|" line start)
1390 (setq start (+ (match-end 0) (length (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart))))
1391 (or (pop vl1) (setq line (replace-match (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart) t t line)))))
1392 (setq line (concat line bodytablerowend))
1393 (push line rtn))
1394 (setq rtn (cons bodytableend rtn))
1395 (nreverse rtn))))
1397 (defun org-colgroup-info-to-vline-list (info)
1398 (let (vl new last)
1399 (while info
1400 (setq last new new (pop info))
1401 (if (or (memq last '(:end :startend))
1402 (memq new '(:start :startend)))
1403 (push t vl)
1404 (push nil vl)))
1405 (setq vl (nreverse vl))
1406 (and vl (setcar vl nil))
1407 vl))
1410 ;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
1411 (defvar org-export-generic-emphasis-alist
1412 '(("*" format-boldify nil)
1413 ("/" format-italicize nil)
1414 ("_" format-underline nil)
1415 ("+" format-strikethrough nil)
1416 ("=" format-code t)
1417 ("~" format-verbatim t))
1418 "Alist of org format -> formatting variables for fontification.
1419 Each element of the list is a list of three elements.
1420 The first element is the character used as a marker for fontification.
1421 The second element is a variable name, set in org-export-generic. That
1422 variable will be dereferenced to obtain a formatting string to wrap
1423 fontified text with.
1424 The third element decides whether to protect converted text from other
1425 conversions.")
1427 ;;; Cargo-culted from the latex translation. I couldn't figure out how
1428 ;;; to keep the structure since the generic export operates on lines, rather
1429 ;;; than on a buffer as in the latex export, meaning that none of the
1430 ;;; search forward code could be kept. This led me to rewrite the
1431 ;;; whole thing recursively. A huge lose for efficiency (potentially),
1432 ;;; but I couldn't figure out how to make the looping work.
1433 ;;; Worse, it's /doubly/ recursive, because this function calls
1434 ;;; org-export-generic-emph-format, which can call it recursively...
1435 ;;; [2010/05/20:rpg]
1436 (defun org-export-generic-fontify (string)
1437 "Convert fontification according to generic rules."
1438 (if (string-match org-emph-re string)
1439 ;; The match goes one char after the *string*, except at the end of a line
1440 (let ((emph (assoc (match-string 3 string)
1441 org-export-generic-emphasis-alist))
1442 (beg (match-beginning 0))
1443 (end (match-end 0)))
1444 (unless emph
1445 (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
1446 (match-string 3 string)))
1447 ;; now we need to determine whether we have strikethrough or
1448 ;; a list, which is a bit nasty
1449 (if (and (equal (match-string 3 string) "+")
1450 (save-match-data
1451 (string-match "\\`-+\\'" (match-string 4 string))))
1452 ;; a list --- skip this match and recurse on the point after the
1453 ;; first emph char...
1454 (concat (substring string 0 (1+ (match-beginning 3)))
1455 (org-export-generic-fontify (substring string (match-beginning 3))))
1456 (concat (substring string 0 beg) ;; part before the match
1457 (match-string 1 string)
1458 (org-export-generic-emph-format (second emph)
1459 (match-string 4 string)
1460 (third emph))
1461 (or (match-string 5 string) "")
1462 (org-export-generic-fontify (substring string end)))))
1463 string))
1465 (defun org-export-generic-emph-format (format-varname string protect)
1466 "Return a string that results from applying the markup indicated by
1467 FORMAT-VARNAME to STRING."
1468 (let ((format (symbol-value format-varname)))
1469 (let ((string-to-emphasize
1470 (if protect
1471 string
1472 (org-export-generic-fontify string))))
1473 (if format
1474 (format format string-to-emphasize)
1475 string-to-emphasize))))
1477 (provide 'org-generic)
1478 (provide 'org-export-generic)
1480 ;;; org-export-generic.el ends here