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