code.delx.au - gnu-emacs/blob - lisp/org/org-ascii.el

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