]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-ascii.el
Install org-mode version 7.3
[gnu-emacs] / lisp / org / org-ascii.el
index f66f441d0105657f12e66974f8a9aaed4a6772fa..b48f8efa1cd6e7fbf7f1b3f167bdfd04a801e965 100644 (file)
@@ -1,12 +1,12 @@
 ;;; org-ascii.el --- ASCII export for Org-mode
 
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.31a
+;; Version: 7.3
 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;;
 ;;; Commentary:
 
+;;; Code:
+
 (require 'org-exp)
+
 (eval-when-compile
   (require 'cl))
 
@@ -52,12 +55,34 @@ Org-mode file."
   :type '(repeat character))
 
 (defcustom org-export-ascii-links-to-notes t
-  "Non-nil means, convert links to notes before the next headline.
+  "Non-nil means convert links to notes before the next headline.
 When nil, the link will be exported in place.  If the line becomes long
 in this way, it will be wrapped."
   :group 'org-export-ascii
   :type 'boolean)
 
+(defcustom org-export-ascii-table-keep-all-vertical-lines nil
+  "Non-nil means keep all vertical lines in ASCII tables.
+When nil, vertical lines will be removed except for those needed
+for column grouping."
+  :group 'org-export-ascii
+  :type 'boolean)
+
+(defcustom org-export-ascii-table-widen-columns t
+  "Non-nil means widen narrowed columns for export.
+When nil, narrowed columns will look in ASCII export just like in org-mode,
+i.e. with \"=>\" as ellipsis."
+  :group 'org-export-ascii
+  :type 'boolean)
+
+(defvar org-export-ascii-entities 'ascii
+  "The ascii representation to be used during ascii export.
+Possible values are:
+
+ascii     Only use plain ASCII characters
+latin1    Include Latin-1 character
+utf8      Use all UTF-8 characters")
+
 ;;; Hooks
 
 (defvar org-export-ascii-final-hook nil
@@ -67,6 +92,41 @@ in this way, it will be wrapped."
 
 (defvar org-ascii-current-indentation nil) ; For communication
 
+;;;###autoload
+(defun org-export-as-latin1 (&rest args)
+  "Like `org-export-as-ascii', use latin1 encoding for special symbols."
+  (interactive)
+  (org-export-as-encoding 'org-export-as-ascii (interactive-p)
+                         'latin1 args))
+
+;;;###autoload
+(defun org-export-as-latin1-to-buffer (&rest args)
+  "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
+  (interactive)
+  (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p)
+                         'latin1 args))
+
+;;;###autoload
+(defun org-export-as-utf8 (&rest args)
+  "Like `org-export-as-ascii', use use encoding for special symbols."
+  (interactive)
+  (org-export-as-encoding 'org-export-as-ascii (interactive-p)
+                         'utf8 args))
+
+;;;###autoload
+(defun org-export-as-utf8-to-buffer (&rest args)
+  "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
+  (interactive)
+  (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p)
+                         'utf8 args))
+
+(defun org-export-as-encoding (command interactivep encoding &rest args)
+  (let ((org-export-ascii-entities encoding))
+    (if interactivep
+       (call-interactively command)
+      (apply command args))))
+
+
 ;;;###autoload
 (defun org-export-as-ascii-to-buffer (arg)
   "Call `org-export-as-ascii` with output to a temporary buffer.
@@ -120,7 +180,7 @@ in a window.  A non-interactive call will only return the buffer."
     (setq buffer "*Org ASCII Export*"))
   (let ((transient-mark-mode t) (zmacs-regions t)
        ext-plist rtn)
-    (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
+    (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
     (goto-char end)
     (set-mark (point)) ;; to activate the region
     (goto-char beg)
@@ -149,6 +209,7 @@ resulting ASCII as a string.  When BODY-ONLY is set, don't produce
 the file header and footer.  When PUB-DIR is set, use this as the
 publishing directory."
   (interactive "P")
+  (run-hooks 'org-export-first-hook)
   (setq-default org-todo-line-regexp org-todo-line-regexp)
   (let* ((opt-plist (org-combine-plists (org-default-export-plist)
                                        ext-plist
@@ -157,7 +218,7 @@ publishing directory."
         (rbeg (and region-p (region-beginning)))
         (rend (and region-p (region-end)))
         (subtree-p
-         (if (plist-get opt-plist :ignore-subree-p)
+         (if (plist-get opt-plist :ignore-subtree-p)
              nil
            (when region-p
              (save-excursion
@@ -174,6 +235,11 @@ publishing directory."
                          (if subtree-p
                              (org-export-add-subtree-options opt-plist rbeg)
                            opt-plist)))
+        ;; The following two are dynamically scoped into other
+        ;; routines below.
+        (org-current-export-dir
+         (or pub-dir (org-export-directory :html opt-plist)))
+        (org-current-export-file buffer-file-name)
         (custom-times org-display-custom-times)
         (org-ascii-current-indentation '(0 . 0))
         (level 0) line txt
@@ -212,8 +278,10 @@ publishing directory."
                    (and (not
                          (plist-get opt-plist :skip-before-1st-heading))
                         (org-export-grab-title-from-buffer))
-                   (file-name-sans-extension
-                    (file-name-nondirectory bfname))))
+                   (and (buffer-file-name)
+                        (file-name-sans-extension
+                         (file-name-nondirectory bfname)))
+                   "UNTITLED"))
         (email (plist-get opt-plist :email))
         (language (plist-get opt-plist :language))
         (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
@@ -243,7 +311,7 @@ publishing directory."
                  :add-text (plist-get opt-plist :text))
                 "\n"))
         thetoc have-headings first-heading-pos
-        table-open table-buffer link-buffer link desc desc0 rpl wrap)
+        table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
     (let ((inhibit-read-only t))
       (org-unmodified
        (remove-text-properties (point-min) (point-max)
@@ -279,8 +347,10 @@ publishing directory."
 
       (if (and (or author email)
               org-export-author-info)
-         (insert(concat (nth 1 lang-words) ": " (or author "")
-                         (if email (concat " <" email ">") "")
+         (insert (concat (nth 1 lang-words) ": " (or author "")
+                         (if (and org-export-email-info
+                                  email (string-match "\\S-" email))
+                             (concat " <" email ">") "")
                          "\n")))
 
       (cond
@@ -330,7 +400,7 @@ publishing directory."
 
                         (if (and (memq org-export-with-tags '(not-in-toc nil))
                                  (string-match
-                                  (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
+                                  (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
                                   txt))
                             (setq txt (replace-match "" t t txt)))
                         (if (string-match quote-re0 txt)
@@ -361,10 +431,12 @@ publishing directory."
       ;; Remove the quoted HTML tags.
       (setq line (org-html-expand-for-ascii line))
       ;; Replace links with the description when possible
-      (while (string-match org-bracket-link-regexp line)
-       (setq link (match-string 1 line)
-             desc0 (match-string 3 line)
-             desc (or desc0 (match-string 1 line)))
+      (while (string-match org-bracket-link-analytic-regexp++ line)
+       (setq path (match-string 3 line)
+             link (concat (match-string 1 line) path)
+             type (match-string 2 line)
+             desc0 (match-string 5 line)
+             desc (or desc0 link))
        (if (and (> (length link) 8)
                 (equal (substring link 0 8) "coderef:"))
            (setq line (replace-match
@@ -373,15 +445,18 @@ publishing directory."
                                      (substring link 8)
                                      org-export-code-refs)))
                        t t line))
-         (setq rpl (concat "["
-                           (or (match-string 3 line) (match-string 1 line))
-                           "]"))
-         (when (and desc0 (not (equal desc0 link)))
-           (if org-export-ascii-links-to-notes
-               (push (cons desc0 link) link-buffer)
-             (setq rpl (concat rpl " (" link ")")
-                   wrap (+ (length line) (- (length (match-string 0 line)))
-                           (length desc)))))
+         (setq rpl (concat "[" desc "]"))
+         (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+             (setq rpl (or (save-match-data
+                             (funcall fnc (org-link-unescape path)
+                                      desc0 'ascii))
+                           rpl))
+           (when (and desc0 (not (equal desc0 link)))
+             (if org-export-ascii-links-to-notes
+                 (push (cons desc0 link) link-buffer)
+               (setq rpl (concat rpl " (" link ")")
+                     wrap (+ (length line) (- (length (match-string 0 line)))
+                             (length desc))))))
          (setq line (replace-match rpl t t line))))
       (when custom-times
        (setq line (org-translate-time line)))
@@ -412,7 +487,8 @@ publishing directory."
                   (org-format-table-ascii table-buffer)
                   "\n") "\n")))
        (t
-       (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
+       (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
+                         line)
            (setq line (replace-match "\\1\\3:" t nil line)))
        (setq line (org-fix-indentation line org-ascii-current-indentation))
        ;; Remove forced line breaks
@@ -474,19 +550,39 @@ publishing directory."
       (current-buffer))))
 
 (defun org-export-ascii-preprocess (parameters)
-  "Do extra work for ASCII export"
+  "Do extra work for ASCII export."
+  ;;
+  ;; Realign tables to get rid of narrowing
+  (when org-export-ascii-table-widen-columns
+    (let ((org-table-do-narrow nil))
+      (goto-char (point-min))
+      (org-ascii-replace-entities)
+      (goto-char (point-min))
+      (org-table-map-tables
+       (lambda () (org-if-unprotected (org-table-align)))
+       'quietly)))
   ;; Put quotes around verbatim text
   (goto-char (point-min))
   (while (re-search-forward org-verbatim-re nil t)
-    (goto-char (match-end 2))
-    (backward-delete-char 1) (insert "'")
-    (goto-char (match-beginning 2))
-    (delete-char 1) (insert "`")
-    (goto-char (match-end 2)))
+    (org-if-unprotected-at (match-beginning 4)
+      (goto-char (match-end 2))
+      (backward-delete-char 1) (insert "'")
+      (goto-char (match-beginning 2))
+      (delete-char 1) (insert "`")
+      (goto-char (match-end 2))))
   ;; Remove target markers
   (goto-char (point-min))
   (while (re-search-forward  "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
-    (replace-match "\\1\\2")))
+    (org-if-unprotected-at (match-beginning 1)
+      (replace-match "\\1\\2")))
+  ;; Remove list start counters
+  (goto-char (point-min))
+  (while (org-search-forward-unenclosed
+         "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t)
+    (replace-match ""))
+  (remove-text-properties
+   (point-min) (point-max)
+   '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
 
 (defun org-html-expand-for-ascii (line)
   "Handle quoted HTML for ASCII export."
@@ -496,6 +592,15 @@ publishing directory."
        (setq line (replace-match "" nil nil line))))
   line)
 
+(defun org-ascii-replace-entities ()
+  "Replace entities with the ASCII representation."
+  (let (e)
+    (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
+      (org-if-unprotected-at (match-beginning 1)
+       (setq e (org-entity-get-representation (match-string 1)
+                                              org-export-ascii-entities))
+       (and e (replace-match e t t))))))
+
 (defun org-export-ascii-wrap (line where)
   "Wrap LINE at or before WHERE."
   (let ((ind (org-get-indentation line))
@@ -549,7 +654,7 @@ publishing directory."
          (insert "\n"))
       (setq char (nth (- umax level) (reverse org-export-ascii-underline)))
       (unless org-export-with-tags
-       (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
+       (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
            (setq title (replace-match "" t t title))))
       (if org-export-with-section-numbers
          (setq title (concat (org-section-number level) " " title)))
@@ -585,18 +690,20 @@ publishing directory."
       ;; column and the special lines
       (setq lines (org-table-clean-before-export lines)))
     ;; Get rid of the vertical lines except for grouping
-    (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
-         rtn line vl1 start)
-      (while (setq line (pop lines))
-       (if (string-match org-table-hline-regexp line)
-           (and (string-match "|\\(.*\\)|" line)
-                (setq line (replace-match " \\1" t nil line)))
-         (setq start 0 vl1 vl)
-         (while (string-match "|" line start)
-           (setq start (match-end 0))
-           (or (pop vl1) (setq line (replace-match " " t t line)))))
-       (push line rtn))
-      (nreverse rtn))))
+    (if org-export-ascii-table-keep-all-vertical-lines
+       lines
+      (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
+           rtn line vl1 start)
+       (while (setq line (pop lines))
+         (if (string-match org-table-hline-regexp line)
+             (and (string-match "|\\(.*\\)|" line)
+                  (setq line (replace-match " \\1" t nil line)))
+           (setq start 0 vl1 vl)
+           (while (string-match "|" line start)
+             (setq start (match-end 0))
+             (or (pop vl1) (setq line (replace-match " " t t line)))))
+         (push line rtn))
+       (nreverse rtn)))))
 
 (defun org-colgroup-info-to-vline-list (info)
   (let (vl new last)