lisp/org/org-ascii.el

   1 ;;; org-ascii.el --- ASCII export for Org-mode
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8 ;; Homepage: http://orgmode.org
   9 ;; Version: 7.7
  10 ;;
  11 ;; This file is part of GNU Emacs.
  12 ;;
  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.
  17
  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.
  22
  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/>.
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (require 'org-exp)
  32
  33 (eval-when-compile
  34   (require 'cl))
  35
  36 (defgroup org-export-ascii nil
  37   "Options specific for ASCII export of Org-mode files."
  38   :tag "Org Export ASCII"
  39   :group 'org-export)
  40
  41 (defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$)
  42   "Characters for underlining headings in ASCII export.
  43 In the given sequence, these characters will be used for level 1, 2, ..."
  44   :group 'org-export-ascii
  45   :type '(repeat character))
  46
  47 (defcustom org-export-ascii-bullets '(?* ?+ ?-)
  48   "Bullet characters for headlines converted to lists in ASCII export.
  49 The first character is used for the first lest level generated in this
  50 way, and so on.  If there are more levels than characters given here,
  51 the list will be repeated.
  52 Note that plain lists will keep the same bullets as the have in the
  53 Org-mode file."
  54   :group 'org-export-ascii
  55   :type '(repeat character))
  56
  57 (defcustom org-export-ascii-links-to-notes t
  58   "Non-nil means convert links to notes before the next headline.
  59 When nil, the link will be exported in place.  If the line becomes long
  60 in this way, it will be wrapped."
  61   :group 'org-export-ascii
  62   :type 'boolean)
  63
  64 (defcustom org-export-ascii-table-keep-all-vertical-lines nil
  65   "Non-nil means keep all vertical lines in ASCII tables.
  66 When nil, vertical lines will be removed except for those needed
  67 for column grouping."
  68   :group 'org-export-ascii
  69   :type 'boolean)
  70
  71 (defcustom org-export-ascii-table-widen-columns t
  72   "Non-nil means widen narrowed columns for export.
  73 When nil, narrowed columns will look in ASCII export just like in org-mode,
  74 i.e. with \"=>\" as ellipsis."
  75   :group 'org-export-ascii
  76   :type 'boolean)
  77
  78 (defvar org-export-ascii-entities 'ascii
  79   "The ascii representation to be used during ascii export.
  80 Possible values are:
  81
  82 ascii     Only use plain ASCII characters
  83 latin1    Include Latin-1 character
  84 utf8      Use all UTF-8 characters")
  85
  86 ;;; Hooks
  87
  88 (defvar org-export-ascii-final-hook nil
  89   "Hook run at the end of ASCII export, in the new buffer.")
  90
  91 ;;; ASCII export
  92
  93 (defvar org-ascii-current-indentation nil) ; For communication
  94
  95 ;;;###autoload
  96 (defun org-export-as-latin1 (&rest args)
  97   "Like `org-export-as-ascii', use latin1 encoding for special symbols."
  98   (interactive)
  99   (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any)
 100                           'latin1 args))
 101
 102 ;;;###autoload
 103 (defun org-export-as-latin1-to-buffer (&rest args)
 104   "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
 105   (interactive)
 106   (org-export-as-encoding 'org-export-as-ascii-to-buffer
 107                           (org-called-interactively-p 'any) 'latin1 args))
 108
 109 ;;;###autoload
 110 (defun org-export-as-utf8 (&rest args)
 111   "Like `org-export-as-ascii', use encoding for special symbols."
 112   (interactive)
 113   (org-export-as-encoding 'org-export-as-ascii
 114                           (org-called-interactively-p 'any)
 115                           'utf8 args))
 116
 117 ;;;###autoload
 118 (defun org-export-as-utf8-to-buffer (&rest args)
 119   "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
 120   (interactive)
 121   (org-export-as-encoding 'org-export-as-ascii-to-buffer
 122                           (org-called-interactively-p 'any) 'utf8 args))
 123
 124 (defun org-export-as-encoding (command interactivep encoding &rest args)
 125   (let ((org-export-ascii-entities encoding))
 126     (if interactivep
 127         (call-interactively command)
 128       (apply command args))))
 129
 130
 131 ;;;###autoload
 132 (defun org-export-as-ascii-to-buffer (arg)
 133   "Call `org-export-as-ascii` with output to a temporary buffer.
 134 No file is created.  The prefix ARG is passed through to `org-export-as-ascii'."
 135   (interactive "P")
 136   (org-export-as-ascii arg nil nil "*Org ASCII Export*")
 137   (when org-export-show-temporary-export-buffer
 138     (switch-to-buffer-other-window "*Org ASCII Export*")))
 139
 140 ;;;###autoload
 141 (defun org-replace-region-by-ascii (beg end)
 142   "Assume the current region has org-mode syntax, and convert it to plain ASCII.
 143 This can be used in any buffer.  For example, you could write an
 144 itemized list in org-mode syntax in a Mail buffer and then use this
 145 command to convert it."
 146   (interactive "r")
 147   (let (reg ascii buf pop-up-frames)
 148     (save-window-excursion
 149       (if (org-mode-p)
 150           (setq ascii (org-export-region-as-ascii
 151                       beg end t 'string))
 152         (setq reg (buffer-substring beg end)
 153               buf (get-buffer-create "*Org tmp*"))
 154         (with-current-buffer buf
 155           (erase-buffer)
 156           (insert reg)
 157           (org-mode)
 158           (setq ascii (org-export-region-as-ascii
 159                       (point-min) (point-max) t 'string)))
 160         (kill-buffer buf)))
 161     (delete-region beg end)
 162     (insert ascii)))
 163
 164 ;;;###autoload
 165 (defun org-export-region-as-ascii (beg end &optional body-only buffer)
 166   "Convert region from BEG to END in org-mode buffer to plain ASCII.
 167 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
 168 contents, and only produce the region of converted text, useful for
 169 cut-and-paste operations.
 170 If BUFFER is a buffer or a string, use/create that buffer as a target
 171 of the converted ASCII.  If BUFFER is the symbol `string', return the
 172 produced ASCII as a string and leave not buffer behind.  For example,
 173 a Lisp program could call this function in the following way:
 174
 175   (setq ascii (org-export-region-as-ascii beg end t 'string))
 176
 177 When called interactively, the output buffer is selected, and shown
 178 in a window.  A non-interactive call will only return the buffer."
 179   (interactive "r\nP")
 180   (when (org-called-interactively-p 'any)
 181     (setq buffer "*Org ASCII Export*"))
 182   (let ((transient-mark-mode t) (zmacs-regions t)
 183         ext-plist rtn)
 184     (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
 185     (goto-char end)
 186     (set-mark (point)) ;; to activate the region
 187     (goto-char beg)
 188     (setq rtn (org-export-as-ascii
 189                nil nil ext-plist
 190                buffer body-only))
 191     (if (fboundp 'deactivate-mark) (deactivate-mark))
 192     (if (and (org-called-interactively-p 'any) (bufferp rtn))
 193         (switch-to-buffer-other-window rtn)
 194       rtn)))
 195
 196 ;;;###autoload
 197 (defun org-export-as-ascii (arg &optional hidden ext-plist
 198                                to-buffer body-only pub-dir)
 199   "Export the outline as a pretty ASCII file.
 200 If there is an active region, export only the region.
 201 The prefix ARG specifies how many levels of the outline should become
 202 underlined headlines, default is 3.    Lower levels will become bulleted
 203 lists.  When HIDDEN is non-nil, don't display the ASCII buffer.
 204 EXT-PLIST is a property list with external parameters overriding
 205 org-mode's default settings, but still inferior to file-local
 206 settings.  When TO-BUFFER is non-nil, create a buffer with that
 207 name and export to that buffer.  If TO-BUFFER is the symbol
 208 `string', don't leave any buffer behind but just return the
 209 resulting ASCII as a string.  When BODY-ONLY is set, don't produce
 210 the file header and footer.  When PUB-DIR is set, use this as the
 211 publishing directory."
 212   (interactive "P")
 213   (run-hooks 'org-export-first-hook)
 214   (setq-default org-todo-line-regexp org-todo-line-regexp)
 215   (let* ((opt-plist (org-combine-plists (org-default-export-plist)
 216                                         ext-plist
 217                                         (org-infile-export-plist)))
 218          (region-p (org-region-active-p))
 219          (rbeg (and region-p (region-beginning)))
 220          (rend (and region-p (region-end)))
 221          (subtree-p
 222           (if (plist-get opt-plist :ignore-subtree-p)
 223               nil
 224             (when region-p
 225               (save-excursion
 226                 (goto-char rbeg)
 227                 (and (org-at-heading-p)
 228                      (>= (org-end-of-subtree t t) rend))))))
 229          (level-offset (if subtree-p
 230                            (save-excursion
 231                              (goto-char rbeg)
 232                              (+ (funcall outline-level)
 233                                 (if org-odd-levels-only 1 0)))
 234                          0))
 235          (opt-plist (setq org-export-opt-plist
 236                           (if subtree-p
 237                               (org-export-add-subtree-options opt-plist rbeg)
 238                             opt-plist)))
 239          ;; The following two are dynamically scoped into other
 240          ;; routines below.
 241          (org-current-export-dir
 242           (or pub-dir (org-export-directory :html opt-plist)))
 243          (org-current-export-file buffer-file-name)
 244          (custom-times org-display-custom-times)
 245          (org-ascii-current-indentation '(0 . 0))
 246          (level 0) line txt
 247          (umax nil)
 248          (umax-toc nil)
 249          (case-fold-search nil)
 250          (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
 251          (filename (if to-buffer
 252                        nil
 253                      (concat (file-name-as-directory
 254                               (or pub-dir
 255                                   (org-export-directory :ascii opt-plist)))
 256                              (file-name-sans-extension
 257                               (or (and subtree-p
 258                                        (org-entry-get (region-beginning)
 259                                                       "EXPORT_FILE_NAME" t))
 260                                   (file-name-nondirectory bfname)))
 261                              ".txt")))
 262          (filename (and filename
 263                         (if (equal (file-truename filename)
 264                                    (file-truename bfname))
 265                             (concat filename ".txt")
 266                           filename)))
 267          (buffer (if to-buffer
 268                      (cond
 269                       ((eq to-buffer 'string)
 270                        (get-buffer-create "*Org ASCII Export*"))
 271                       (t (get-buffer-create to-buffer)))
 272                    (find-file-noselect filename)))
 273          (org-levels-open (make-vector org-level-max nil))
 274          (odd org-odd-levels-only)
 275          (date  (plist-get opt-plist :date))
 276          (author (plist-get opt-plist :author))
 277          (title (or (and subtree-p (org-export-get-title-from-subtree))
 278                     (plist-get opt-plist :title)
 279                     (and (not
 280                           (plist-get opt-plist :skip-before-1st-heading))
 281                          (org-export-grab-title-from-buffer))
 282                     (and (buffer-file-name)
 283                          (file-name-sans-extension
 284                           (file-name-nondirectory bfname)))
 285                     "UNTITLED"))
 286          (email (plist-get opt-plist :email))
 287          (language (plist-get opt-plist :language))
 288          (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
 289          (todo nil)
 290          (lang-words nil)
 291          (region
 292           (buffer-substring
 293            (if (org-region-active-p) (region-beginning) (point-min))
 294            (if (org-region-active-p) (region-end) (point-max))))
 295          (org-export-footnotes-seen nil)
 296          (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
 297          (lines (org-split-string
 298                  (org-export-preprocess-string
 299                   region
 300                   :for-backend 'ascii
 301                   :skip-before-1st-heading
 302                   (plist-get opt-plist :skip-before-1st-heading)
 303                   :drawers (plist-get opt-plist :drawers)
 304                   :tags (plist-get opt-plist :tags)
 305                   :priority (plist-get opt-plist :priority)
 306                   :footnotes (plist-get opt-plist :footnotes)
 307                   :timestamps (plist-get opt-plist :timestamps)
 308                   :todo-keywords (plist-get opt-plist :todo-keywords)
 309                   :tasks (plist-get opt-plist :tasks)
 310                   :verbatim-multiline t
 311                   :select-tags (plist-get opt-plist :select-tags)
 312                   :exclude-tags (plist-get opt-plist :exclude-tags)
 313                   :archived-trees
 314                   (plist-get opt-plist :archived-trees)
 315                   :add-text (plist-get opt-plist :text))
 316                  "\n"))
 317          thetoc have-headings first-heading-pos
 318          table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
 319     (let ((inhibit-read-only t))
 320       (org-unmodified
 321        (remove-text-properties (point-min) (point-max)
 322                                '(:org-license-to-kill t))))
 323
 324     (setq org-min-level (org-get-min-level lines level-offset))
 325     (setq org-last-level org-min-level)
 326     (org-init-section-numbers)
 327     (setq lang-words (or (assoc language org-export-language-setup)
 328                          (assoc "en" org-export-language-setup)))
 329     (set-buffer buffer)
 330     (erase-buffer)
 331     (fundamental-mode)
 332     (org-install-letbind)
 333     ;; create local variables for all options, to make sure all called
 334     ;; functions get the correct information
 335     (mapc (lambda (x)
 336             (set (make-local-variable (nth 2 x))
 337                  (plist-get opt-plist (car x))))
 338           org-export-plist-vars)
 339     (org-set-local 'org-odd-levels-only odd)
 340     (setq umax (if arg (prefix-numeric-value arg)
 341                  org-export-headline-levels))
 342     (setq umax-toc (if (integerp org-export-with-toc)
 343                        (min org-export-with-toc umax)
 344                      umax))
 345
 346     ;; File header
 347     (unless body-only
 348       (when (and title (not (string= "" title)))
 349         (org-insert-centered title ?=)
 350         (insert "\n"))
 351
 352       (if (and (or author email)
 353                org-export-author-info)
 354           (insert (concat (nth 1 lang-words) ": " (or author "")
 355                           (if (and org-export-email-info
 356                                    email (string-match "\\S-" email))
 357                               (concat " <" email ">") "")
 358                           "\n")))
 359
 360       (cond
 361        ((and date (string-match "%" date))
 362         (setq date (format-time-string date)))
 363        (date)
 364        (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
 365
 366       (if (and date org-export-time-stamp-file)
 367           (insert (concat (nth 2 lang-words) ": " date"\n")))
 368
 369       (unless (= (point) (point-min))
 370         (insert "\n\n")))
 371
 372     (if (and org-export-with-toc (not body-only))
 373         (progn
 374           (push (concat (nth 3 lang-words) "\n") thetoc)
 375           (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
 376                         "\n") thetoc)
 377           (mapc #'(lambda (line)
 378                    (if (string-match org-todo-line-regexp
 379                                      line)
 380                        ;; This is a headline
 381                        (progn
 382                          (setq have-headings t)
 383                          (setq level (- (match-end 1) (match-beginning 1)
 384                                         level-offset)
 385                                level (org-tr-level level)
 386                                txt (match-string 3 line)
 387                                todo
 388                                (or (and org-export-mark-todo-in-toc
 389                                         (match-beginning 2)
 390                                         (not (member (match-string 2 line)
 391                                                      org-done-keywords)))
 392                                         ; TODO, not DONE
 393                                    (and org-export-mark-todo-in-toc
 394                                         (= level umax-toc)
 395                                         (org-search-todo-below
 396                                          line lines level))))
 397                          (setq txt (org-html-expand-for-ascii txt))
 398
 399                          (while (string-match org-bracket-link-regexp txt)
 400                            (setq txt
 401                                  (replace-match
 402                                   (match-string (if (match-end 2) 3 1) txt)
 403                                   t t txt)))
 404
 405                          (if (and (memq org-export-with-tags '(not-in-toc nil))
 406                                   (string-match
 407                                    (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
 408                                    txt))
 409                              (setq txt (replace-match "" t t txt)))
 410                          (if (string-match quote-re0 txt)
 411                              (setq txt (replace-match "" t t txt)))
 412
 413                          (if org-export-with-section-numbers
 414                              (setq txt (concat (org-section-number level)
 415                                                " " txt)))
 416                          (if (<= level umax-toc)
 417                              (progn
 418                                (push
 419                                 (concat
 420                                  (make-string
 421                                   (* (max 0 (- level org-min-level)) 4) ?\ )
 422                                  (format (if todo "%s (*)\n" "%s\n") txt))
 423                                 thetoc)
 424                                (setq org-last-level level))
 425                            ))))
 426                 lines)
 427           (setq thetoc (if have-headings (nreverse thetoc) nil))))
 428
 429     (org-init-section-numbers)
 430     (while (setq line (pop lines))
 431       (when (and link-buffer (string-match org-outline-regexp-bol line))
 432         (org-export-ascii-push-links (nreverse link-buffer))
 433         (setq link-buffer nil))
 434       (setq wrap nil)
 435       ;; Remove the quoted HTML tags.
 436       (setq line (org-html-expand-for-ascii line))
 437       ;; Replace links with the description when possible
 438       (while (string-match org-bracket-link-analytic-regexp++ line)
 439         (setq path (match-string 3 line)
 440               link (concat (match-string 1 line) path)
 441               type (match-string 2 line)
 442               desc0 (match-string 5 line)
 443               desc (or desc0 link))
 444         (if (and (> (length link) 8)
 445                  (equal (substring link 0 8) "coderef:"))
 446             (setq line (replace-match
 447                         (format (org-export-get-coderef-format (substring link 8) desc)
 448                                 (cdr (assoc
 449                                       (substring link 8)
 450                                       org-export-code-refs)))
 451                         t t line))
 452           (setq rpl (concat "[" desc "]"))
 453           (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
 454               (setq rpl (or (save-match-data
 455                               (funcall fnc (org-link-unescape path)
 456                                        desc0 'ascii))
 457                             rpl))
 458             (when (and desc0 (not (equal desc0 link)))
 459               (if org-export-ascii-links-to-notes
 460                   (push (cons desc0 link) link-buffer)
 461                 (setq rpl (concat rpl " (" link ")")
 462                       wrap (+ (length line) (- (length (match-string 0 line)))
 463                               (length desc))))))
 464           (setq line (replace-match rpl t t line))))
 465       (when custom-times
 466         (setq line (org-translate-time line)))
 467       (cond
 468        ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
 469         ;; a Headline
 470         (setq first-heading-pos (or first-heading-pos (point)))
 471         (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
 472                                      level-offset))
 473               txt (match-string 2 line))
 474         (org-ascii-level-start level txt umax lines))
 475
 476        ((and org-export-with-tables
 477              (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
 478         (if (not table-open)
 479             ;; New table starts
 480             (setq table-open t table-buffer nil))
 481         ;; Accumulate lines
 482         (setq table-buffer (cons line table-buffer))
 483         (when (or (not lines)
 484                   (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
 485                                      (car lines))))
 486           (setq table-open nil
 487                 table-buffer (nreverse table-buffer))
 488           (insert (mapconcat
 489                    (lambda (x)
 490                      (org-fix-indentation x org-ascii-current-indentation))
 491                    (org-format-table-ascii table-buffer)
 492                    "\n") "\n")))
 493        (t
 494         (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
 495                           line)
 496             (setq line (replace-match "\\1\\3:" t nil line)))
 497         (setq line (org-fix-indentation line org-ascii-current-indentation))
 498         ;; Remove forced line breaks
 499         (if (string-match "\\\\\\\\[ \t]*$" line)
 500             (setq line (replace-match "" t t line)))
 501         (if (and org-export-with-fixed-width
 502                  (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
 503             (setq line (replace-match "\\1" nil nil line))
 504           (if wrap (setq line (org-export-ascii-wrap line wrap))))
 505         (insert line "\n"))))
 506
 507     (org-export-ascii-push-links (nreverse link-buffer))
 508
 509     (normal-mode)
 510
 511     ;; insert the table of contents
 512     (when thetoc
 513       (goto-char (point-min))
 514       (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
 515           (progn
 516             (goto-char (match-beginning 0))
 517             (replace-match ""))
 518         (goto-char first-heading-pos))
 519       (mapc 'insert thetoc)
 520       (or (looking-at "[ \t]*\n[ \t]*\n")
 521           (insert "\n\n")))
 522
 523     ;; Convert whitespace place holders
 524     (goto-char (point-min))
 525     (let (beg end)
 526       (while (setq beg (next-single-property-change (point) 'org-whitespace))
 527         (setq end (next-single-property-change beg 'org-whitespace))
 528         (goto-char beg)
 529         (delete-region beg end)
 530         (insert (make-string (- end beg) ?\ ))))
 531
 532     ;; remove display and invisible chars
 533     (let (beg end)
 534       (goto-char (point-min))
 535       (while (setq beg (next-single-property-change (point) 'display))
 536         (setq end (next-single-property-change beg 'display))
 537         (delete-region beg end)
 538         (goto-char beg)
 539         (insert "=>"))
 540       (goto-char (point-min))
 541       (while (setq beg (next-single-property-change (point) 'org-cwidth))
 542         (setq end (next-single-property-change beg 'org-cwidth))
 543         (delete-region beg end)
 544         (goto-char beg)))
 545     (run-hooks 'org-export-ascii-final-hook)
 546     (or to-buffer (save-buffer))
 547     (goto-char (point-min))
 548     (or (org-export-push-to-kill-ring "ASCII")
 549         (message "Exporting... done"))
 550     ;; Return the buffer or a string, according to how this function was called
 551     (if (eq to-buffer 'string)
 552         (prog1 (buffer-substring (point-min) (point-max))
 553           (kill-buffer (current-buffer)))
 554       (current-buffer))))
 555
 556 (defun org-export-ascii-preprocess (parameters)
 557   "Do extra work for ASCII export."
 558   ;;
 559   ;; Realign tables to get rid of narrowing
 560   (when org-export-ascii-table-widen-columns
 561     (let ((org-table-do-narrow nil))
 562       (goto-char (point-min))
 563       (org-ascii-replace-entities)
 564       (goto-char (point-min))
 565       (org-table-map-tables
 566        (lambda () (org-if-unprotected (org-table-align)))
 567        'quietly)))
 568   ;; Put quotes around verbatim text
 569   (goto-char (point-min))
 570   (while (re-search-forward org-verbatim-re nil t)
 571     (org-if-unprotected-at (match-beginning 4)
 572       (goto-char (match-end 2))
 573       (backward-delete-char 1) (insert "'")
 574       (goto-char (match-beginning 2))
 575       (delete-char 1) (insert "`")
 576       (goto-char (match-end 2))))
 577   ;; Remove target markers
 578   (goto-char (point-min))
 579   (while (re-search-forward  "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
 580     (org-if-unprotected-at (match-beginning 1)
 581       (replace-match "\\1\\2")))
 582   ;; Remove list start counters
 583   (goto-char (point-min))
 584   (while (org-list-search-forward
 585           "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t)
 586     (replace-match ""))
 587   (remove-text-properties
 588    (point-min) (point-max)
 589    '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
 590
 591 (defun org-html-expand-for-ascii (line)
 592   "Handle quoted HTML for ASCII export."
 593   (if org-export-html-expand
 594       (while (string-match "@<[^<>\n]*>" line)
 595         ;; We just remove the tags for now.
 596         (setq line (replace-match "" nil nil line))))
 597   line)
 598
 599 (defun org-ascii-replace-entities ()
 600   "Replace entities with the ASCII representation."
 601   (let (e)
 602     (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
 603       (org-if-unprotected-at (match-beginning 1)
 604         (setq e (org-entity-get-representation (match-string 1)
 605                                                org-export-ascii-entities))
 606         (and e (replace-match e t t))))))
 607
 608 (defun org-export-ascii-wrap (line where)
 609   "Wrap LINE at or before WHERE."
 610   (let ((ind (org-get-indentation line))
 611         pos)
 612     (catch 'found
 613       (loop for i from where downto (/ where 2) do
 614             (and (equal (aref line i) ?\ )
 615                  (setq pos i)
 616                  (throw 'found t))))
 617     (if pos
 618         (concat (substring line 0 pos) "\n"
 619                 (make-string ind ?\ )
 620                 (substring line (1+ pos)))
 621       line)))
 622
 623 (defun org-export-ascii-push-links (link-buffer)
 624   "Push out links in the buffer."
 625   (when link-buffer
 626     ;; We still have links to push out.
 627     (insert "\n")
 628     (let ((ind ""))
 629       (save-match-data
 630         (if (save-excursion
 631               (re-search-backward
 632                (concat "^\\(\\([ \t]*\\)\\|\\("
 633                        org-outline-regexp
 634                        "\\)\\)[^ \t\n]") nil t))
 635             (setq ind (or (match-string 2)
 636                           (make-string (length (match-string 3)) ?\ )))))
 637       (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
 638             link-buffer))
 639     (insert "\n")))
 640
 641 (defun org-ascii-level-start (level title umax &optional lines)
 642   "Insert a new level in ASCII export."
 643   (let (char (n (- level umax 1)) (ind 0))
 644     (if (> level umax)
 645         (progn
 646           (insert (make-string (* 2 n) ?\ )
 647                   (char-to-string (nth (% n (length org-export-ascii-bullets))
 648                                        org-export-ascii-bullets))
 649                   " " title "\n")
 650           ;; find the indentation of the next non-empty line
 651           (catch 'stop
 652             (while lines
 653               (if (string-match "^\\* " (car lines)) (throw 'stop nil))
 654               (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
 655                   (throw 'stop (setq ind (org-get-indentation (car lines)))))
 656               (pop lines)))
 657           (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
 658       (if (or (not (equal (char-before) ?\n))
 659               (not (equal (char-before (1- (point))) ?\n)))
 660           (insert "\n"))
 661       (setq char (or (nth (1- level) org-export-ascii-underline)
 662                      (car (last org-export-ascii-underline))))
 663       (unless org-export-with-tags
 664         (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
 665             (setq title (replace-match "" t t title))))
 666       (if org-export-with-section-numbers
 667           (setq title (concat (org-section-number level) " " title)))
 668       (insert title "\n" (make-string (string-width title) char) "\n")
 669       (setq org-ascii-current-indentation '(0 . 0)))))
 670
 671 (defun org-insert-centered (s &optional underline)
 672   "Insert the string S centered and underline it with character UNDERLINE."
 673   (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
 674     (insert (make-string ind ?\ ) s "\n")
 675     (if underline
 676         (insert (make-string ind ?\ )
 677                 (make-string (string-width s) underline)
 678                 "\n"))))
 679
 680 (defvar org-table-colgroup-info nil)
 681 (defun org-format-table-ascii (lines)
 682   "Format a table for ascii export."
 683   (if (stringp lines)
 684       (setq lines (org-split-string lines "\n")))
 685   (if (not (string-match "^[ \t]*|" (car lines)))
 686       ;; Table made by table.el - test for spanning
 687       lines
 688
 689     ;; A normal org table
 690     ;; Get rid of hlines at beginning and end
 691     (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
 692     (setq lines (nreverse lines))
 693     (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
 694     (setq lines (nreverse lines))
 695     (when org-export-table-remove-special-lines
 696       ;; Check if the table has a marking column.  If yes remove the
 697       ;; column and the special lines
 698       (setq lines (org-table-clean-before-export lines)))
 699     ;; Get rid of the vertical lines except for grouping
 700     (if org-export-ascii-table-keep-all-vertical-lines
 701         lines
 702       (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
 703             rtn line vl1 start)
 704         (while (setq line (pop lines))
 705           (if (string-match org-table-hline-regexp line)
 706               (and (string-match "|\\(.*\\)|" line)
 707                    (setq line (replace-match " \\1" t nil line)))
 708             (setq start 0 vl1 vl)
 709             (while (string-match "|" line start)
 710               (setq start (match-end 0))
 711               (or (pop vl1) (setq line (replace-match " " t t line)))))
 712           (push line rtn))
 713         (nreverse rtn)))))
 714
 715 (defun org-colgroup-info-to-vline-list (info)
 716   (let (vl new last)
 717     (while info
 718       (setq last new new (pop info))
 719       (if (or (memq last '(:end :startend))
 720               (memq new  '(:start :startend)))
 721           (push t vl)
 722         (push nil vl)))
 723     (setq vl (nreverse vl))
 724     (and vl (setcar vl nil))
 725     vl))
 726
 727 (provide 'org-ascii)
 728
 729 ;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c
 730 ;;; org-ascii.el ends here