lisp/org-ascii.el

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