lisp/org-ascii.el

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