From 9682e038ff0307ba079742ef5420df9027c5c1ec Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 7 Apr 2009 18:40:16 +0200 Subject: [PATCH] ASCII export: moved functions to new file, org-ascii.el --- Makefile | 2 + lisp/ChangeLog | 4 + lisp/org-ascii.el | 516 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/org-exp.el | 483 +------------------------------------------------- lisp/org.el | 11 +- 5 files changed, 533 insertions(+), 483 deletions(-) create mode 100644 lisp/org-ascii.el diff --git a/Makefile b/Makefile index 254e0c8d9..f59549119 100644 --- a/Makefile +++ b/Makefile @@ -62,6 +62,7 @@ INSTALL_INFO=install-info # The following variables need to be defined by the maintainer LISPF = org.el \ org-agenda.el \ + org-ascii.el \ org-attach.el \ org-archive.el \ org-bbdb.el \ @@ -316,6 +317,7 @@ dummy: lisp/org.elc: lisp/org-macs.el lisp/org-compat.el lisp/org-faces.el lisp/org-agenda.elc: lisp/org.el +lisp/org-ascii.elc: lisp/org-exp.el lisp/org-attach.elc: lisp/org.el lisp/org-id.el lisp/org-archive.elc: lisp/org.el lisp/org-bbdb.elc: lisp/org.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 23b7c2b0a..75063db1f 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2009-04-07 Carsten Dominik + + * org-ascii.el: New file, split out from org-exp.el. + 2009-04-06 Carsten Dominik * org-compat.el (org-find-library-name): New function. diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el new file mode 100644 index 000000000..2c3fc7488 --- /dev/null +++ b/lisp/org-ascii.el @@ -0,0 +1,516 @@ +;;; org-exp.el --- ASCII export for Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.25trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +(require 'org-exp) + +(defgroup org-export-ascii nil + "Options specific for ASCII export of Org-mode files." + :tag "Org Export ASCII" + :group 'org-export) + +(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) + "Characters for underlining headings in ASCII export. +In the given sequence, these characters will be used for level 1, 2, ..." + :group 'org-export-ascii + :type '(repeat character)) + +(defcustom org-export-ascii-bullets '(?* ?+ ?-) + "Bullet characters for headlines converted to lists in ASCII export. +The first character is used for the first lest level generated in this +way, and so on. If there are more levels than characters given here, +the list will be repeated. +Note that plain lists will keep the same bullets as the have in the +Org-mode file." + :group 'org-export-ascii + :type '(repeat character)) + +(defcustom org-export-ascii-links-to-notes t + "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) + + +;;; ASCII export + +(defvar org-ascii-current-indentation nil) ; For communication + +;;;###autoload +(defun org-export-as-ascii (arg) + "Export the outline as a pretty ASCII file. +If there is an active region, export only the region. +The prefix ARG specifies how many levels of the outline should become +underlined headlines. The default is 3." + (interactive "P") + (setq-default org-todo-line-regexp org-todo-line-regexp) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (region-p (org-region-active-p)) + (rbeg (and region-p (region-beginning))) + (rend (and region-p (region-end))) + (subtree-p + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend))))) + (level-offset (if subtree-p + (save-excursion + (goto-char rbeg) + (+ (funcall outline-level) + (if org-odd-levels-only 1 0))) + 0)) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) + (custom-times org-display-custom-times) + (org-ascii-current-indentation '(0 . 0)) + (level 0) line txt + (umax nil) + (umax-toc nil) + (case-fold-search nil) + (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) + (filename (concat (file-name-as-directory + (org-export-directory :ascii opt-plist)) + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory bfname))) + ".txt")) + (filename (if (equal (file-truename filename) + (file-truename bfname)) + (concat filename ".txt") + filename)) + (buffer (find-file-noselect filename)) + (org-levels-open (make-vector org-level-max nil)) + (odd org-odd-levels-only) + (date (plist-get opt-plist :date)) + (author (plist-get opt-plist :author)) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (file-name-sans-extension + (file-name-nondirectory bfname)))) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) +; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) + (todo nil) + (lang-words nil) + (region + (buffer-substring + (if (org-region-active-p) (region-beginning) (point-min)) + (if (org-region-active-p) (region-end) (point-max)))) + (lines (org-split-string + (org-export-preprocess-string + region + :for-ascii t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :footnotes (plist-get opt-plist :footnotes) + :timestamps (plist-get opt-plist :timestamps) + :todo-keywords (plist-get opt-plist :todo-keywords) + :verbatim-multiline t + :select-tags (plist-get opt-plist :select-tags) + :exclude-tags (plist-get opt-plist :exclude-tags) + :archived-trees + (plist-get opt-plist :archived-trees) + :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) + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill t)))) + + (setq org-min-level (org-get-min-level lines level-offset)) + (setq org-last-level org-min-level) + (org-init-section-numbers) + + (find-file-noselect filename) + + (setq lang-words (or (assoc language org-export-language-setup) + (assoc "en" org-export-language-setup))) + (switch-to-buffer-other-window buffer) + (erase-buffer) + (fundamental-mode) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapc (lambda (x) + (set (make-local-variable (nth 2 x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (org-set-local 'org-odd-levels-only odd) + (setq umax (if arg (prefix-numeric-value arg) + org-export-headline-levels)) + (setq umax-toc (if (integerp org-export-with-toc) + (min org-export-with-toc umax) + umax)) + + ;; File header + (if title (org-insert-centered title ?=)) + (insert "\n") + (if (and (or author email) + org-export-author-info) + (insert (concat (nth 1 lang-words) ": " (or author "") + (if email (concat " <" email ">") "") + "\n"))) + + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date))) + (date) + (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + + (if (and date org-export-time-stamp-file) + (insert (concat (nth 2 lang-words) ": " date"\n"))) + + (insert "\n\n") + + (if org-export-with-toc + (progn + (push (concat (nth 3 lang-words) "\n") thetoc) + (push (concat (make-string (string-width (nth 3 lang-words)) ?=) + "\n") thetoc) + (mapc '(lambda (line) + (if (string-match org-todo-line-regexp + line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) + ; TODO, not DONE + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-ascii txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (memq org-export-with-tags '(not-in-toc nil)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + + (if org-export-with-section-numbers + (setq txt (concat (org-section-number level) + " " txt))) + (if (<= level umax-toc) + (progn + (push + (concat + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) + (format (if todo "%s (*)\n" "%s\n") txt)) + thetoc) + (setq org-last-level level)) + )))) + lines) + (setq thetoc (if have-headings (nreverse thetoc) nil)))) + + (org-init-section-numbers) + (while (setq line (pop lines)) + (when (and link-buffer (string-match "^\\*+ " line)) + (org-export-ascii-push-links (nreverse link-buffer)) + (setq link-buffer nil)) + (setq wrap nil) + ;; 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))) + (if (and (> (length link) 8) + (equal (substring link 0 8) "coderef:")) + (setq line (replace-match + (format (org-export-get-coderef-format (substring link 8) desc) + (cdr (assoc + (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))) + (length desc))))) + (setq line (replace-match rpl t t line)))) + (when custom-times + (setq line (org-translate-time line))) + (cond + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ;; a Headline + (setq first-heading-pos (or first-heading-pos (point))) + (setq level (org-tr-level (- (match-end 1) (match-beginning 1) + level-offset)) + txt (match-string 2 line)) + (org-ascii-level-start level txt umax lines)) + + ((and org-export-with-tables + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (if (not table-open) + ;; New table starts + (setq table-open t table-buffer nil)) + ;; Accumulate lines + (setq table-buffer (cons line table-buffer)) + (when (or (not lines) + (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" + (car lines)))) + (setq table-open nil + table-buffer (nreverse table-buffer)) + (insert (mapconcat + (lambda (x) + (org-fix-indentation x org-ascii-current-indentation)) + (org-format-table-ascii table-buffer) + "\n") "\n"))) + (t + (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 + (if (string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "" t t line))) + (if (and org-export-with-fixed-width + (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) + (setq line (replace-match "\\1" nil nil line)) + (if wrap (setq line (org-export-ascii-wrap line wrap)))) + (insert line "\n")))) + + (org-export-ascii-push-links (nreverse link-buffer)) + + (normal-mode) + + ;; insert the table of contents + (when thetoc + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) + (progn + (goto-char (match-beginning 0)) + (replace-match "")) + (goto-char first-heading-pos)) + (mapc 'insert thetoc) + (or (looking-at "[ \t]*\n[ \t]*\n") + (insert "\n\n"))) + + ;; Convert whitespace place holders + (goto-char (point-min)) + (let (beg end) + (while (setq beg (next-single-property-change (point) 'org-whitespace)) + (setq end (next-single-property-change beg 'org-whitespace)) + (goto-char beg) + (delete-region beg end) + (insert (make-string (- end beg) ?\ )))) + + (save-buffer) + ;; remove display and invisible chars + (let (beg end) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'display)) + (setq end (next-single-property-change beg 'display)) + (delete-region beg end) + (goto-char beg) + (insert "=>")) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'org-cwidth)) + (setq end (next-single-property-change beg 'org-cwidth)) + (delete-region beg end) + (goto-char beg))) + (goto-char (point-min)))) + +(defun org-export-ascii-preprocess () + "Do extra work for ASCII export" + ;; 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))) + ;; Remove target markers + (goto-char (point-min)) + (while (re-search-forward "<<]*\\)>>>?\\([ \t]*\\)" nil t) + (replace-match "\\1\\2"))) + +(defun org-html-expand-for-ascii (line) + "Handle quoted HTML for ASCII export." + (if org-export-html-expand + (while (string-match "@<[^<>\n]*>" line) + ;; We just remove the tags for now. + (setq line (replace-match "" nil nil line)))) + line) + + +(defun org-export-ascii-wrap (line where) + "Wrap LINE at or before WHERE." + (let ((ind (org-get-indentation line)) + pos) + (catch 'found + (loop for i from where downto (/ where 2) do + (and (equal (aref line i) ?\ ) + (setq pos i) + (throw 'found t)))) + (if pos + (concat (substring line 0 pos) "\n" + (make-string ind ?\ ) + (substring line (1+ pos))) + line))) + +(defun org-export-ascii-push-links (link-buffer) + "Push out links in the buffer." + (when link-buffer + ;; We still have links to push out. + (insert "\n") + (let ((ind "")) + (save-match-data + (if (save-excursion + (re-search-backward + "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) + (setq ind (or (match-string 2) + (make-string (length (match-string 3)) ?\ ))))) + (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) + link-buffer)) + (insert "\n"))) + +(defun org-ascii-level-start (level title umax &optional lines) + "Insert a new level in ASCII export." + (let (char (n (- level umax 1)) (ind 0)) + (if (> level umax) + (progn + (insert (make-string (* 2 n) ?\ ) + (char-to-string (nth (% n (length org-export-ascii-bullets)) + org-export-ascii-bullets)) + " " title "\n") + ;; find the indentation of the next non-empty line + (catch 'stop + (while lines + (if (string-match "^\\* " (car lines)) (throw 'stop nil)) + (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) + (throw 'stop (setq ind (org-get-indentation (car lines))))) + (pop lines))) + (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) + (if (or (not (equal (char-before) ?\n)) + (not (equal (char-before (1- (point))) ?\n))) + (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) + (setq title (replace-match "" t t title)))) + (if org-export-with-section-numbers + (setq title (concat (org-section-number level) " " title))) + (insert title "\n" (make-string (string-width title) char) "\n") + (setq org-ascii-current-indentation '(0 . 0))))) + +(defun org-insert-centered (s &optional underline) + "Insert the string S centered and underline it with character UNDERLINE." + (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) + (insert (make-string ind ?\ ) s "\n") + (if underline + (insert (make-string ind ?\ ) + (make-string (string-width s) underline) + "\n")))) + +(defvar org-table-colgroup-info nil) +(defun org-format-table-ascii (lines) + "Format a table for ascii export." + (if (stringp lines) + (setq lines (org-split-string lines "\n"))) + (if (not (string-match "^[ \t]*|" (car lines))) + ;; Table made by table.el - test for spanning + lines + + ;; A normal org table + ;; Get rid of hlines at beginning and end + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (when org-export-table-remove-special-lines + ;; Check if the table has a marking column. If yes remove the + ;; 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)))) + +(defun org-colgroup-info-to-vline-list (info) + (let (vl new last) + (while info + (setq last new new (pop info)) + (if (or (memq last '(:end :startend)) + (memq new '(:start :startend))) + (push t vl) + (push nil vl))) + (setq vl (nreverse vl)) + (and vl (setcar vl nil)) + vl)) + +(provide 'org-ascii) + +;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c + +;;; org-ascii.el ends here diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 13142a585..23a567365 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -488,33 +488,6 @@ much faster." :group 'org-export-tables :type 'boolean) -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-links-to-notes t - "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) (defgroup org-export-xml nil "Options specific for XML export of Org-mode files." @@ -938,6 +911,9 @@ or if they are only using it locally." (defvar org-current-export-dir nil) ; dynamically scoped parameter (defvar org-export-opt-plist nil "Contains the current option plist.") +(defvar org-last-level nil) ; dynamically scoped variable +(defvar org-min-level nil) ; dynamically scoped variable +(defvar org-levels-open nil) ; dynamically scoped parameter (defconst org-export-plist-vars '((:link-up nil org-export-html-link-up) @@ -2653,338 +2629,6 @@ Numbering lines works for all three major backends (html, latex, and ascii)." (newline) (buffer-string)))) -;;; ASCII export - -(defvar org-last-level nil) ; dynamically scoped variable -(defvar org-min-level nil) ; dynamically scoped variable -(defvar org-levels-open nil) ; dynamically scoped parameter -(defvar org-ascii-current-indentation nil) ; For communication - -;;;###autoload -(defun org-export-as-ascii (arg) - "Export the outline as a pretty ASCII file. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines. The default is 3." - (interactive "P") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - (custom-times org-display-custom-times) - (org-ascii-current-indentation '(0 . 0)) - (level 0) line txt - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (org-export-directory :ascii opt-plist)) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".txt")) - (filename (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename ".txt") - filename)) - (buffer (find-file-noselect filename)) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory bfname)))) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) -; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (lines (org-split-string - (org-export-preprocess-string - region - :for-ascii t - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :verbatim-multiline t - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :archived-trees - (plist-get opt-plist :archived-trees) - :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) - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (find-file-noselect filename) - - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (switch-to-buffer-other-window buffer) - (erase-buffer) - (fundamental-mode) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - - ;; File header - (if title (org-insert-centered title ?=)) - (insert "\n") - (if (and (or author email) - org-export-author-info) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if email (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date org-export-time-stamp-file) - (insert (concat (nth 2 lang-words) ": " date"\n"))) - - (insert "\n\n") - - (if org-export-with-toc - (progn - (push (concat (nth 3 lang-words) "\n") thetoc) - (push (concat (make-string (string-width (nth 3 lang-words)) ?=) - "\n") thetoc) - (mapc '(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) - lines) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (while (setq line (pop lines)) - (when (and link-buffer (string-match "^\\*+ " line)) - (org-export-ascii-push-links (nreverse link-buffer)) - (setq link-buffer nil)) - (setq wrap nil) - ;; 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))) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (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))) - (length desc))))) - (setq line (replace-match rpl t t line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; a Headline - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (org-ascii-level-start level txt umax lines)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-ascii-current-indentation)) - (org-format-table-ascii table-buffer) - "\n") "\n"))) - (t - (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 - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - (if (and org-export-with-fixed-width - (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) - (setq line (replace-match "\\1" nil nil line)) - (if wrap (setq line (org-export-ascii-wrap line wrap)))) - (insert line "\n")))) - - (org-export-ascii-push-links (nreverse link-buffer)) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - (save-buffer) - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (goto-char (point-min)))) - -(defun org-export-ascii-preprocess () - "Do extra work for ASCII export" - ;; 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))) - ;; Remove target markers - (goto-char (point-min)) - (while (re-search-forward "<<]*\\)>>>?\\([ \t]*\\)" nil t) - (replace-match "\\1\\2"))) - (defun org-search-todo-below (line lines level) "Search the subtree below LINE for any TODO entries." (let ((rest (cdr (memq line lines))) @@ -3002,84 +2646,6 @@ underlined headlines. The default is 3." (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) -(defun org-html-expand-for-ascii (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - - -(defun org-export-ascii-wrap (line where) - "Wrap LINE at or before WHERE." - (let ((ind (org-get-indentation line)) - pos) - (catch 'found - (loop for i from where downto (/ where 2) do - (and (equal (aref line i) ?\ ) - (setq pos i) - (throw 'found t)))) - (if pos - (concat (substring line 0 pos) "\n" - (make-string ind ?\ ) - (substring line (1+ pos))) - line))) - -(defun org-export-ascii-push-links (link-buffer) - "Push out links in the buffer." - (when link-buffer - ;; We still have links to push out. - (insert "\n") - (let ((ind "")) - (save-match-data - (if (save-excursion - (re-search-backward - "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) - (setq ind (or (match-string 2) - (make-string (length (match-string 3)) ?\ ))))) - (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) - link-buffer)) - (insert "\n"))) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defun org-ascii-level-start (level title umax &optional lines) - "Insert a new level in ASCII export." - (let (char (n (- level umax 1)) (ind 0)) - (if (> level umax) - (progn - (insert (make-string (* 2 n) ?\ ) - (char-to-string (nth (% n (length org-export-ascii-bullets)) - org-export-ascii-bullets)) - " " title "\n") - ;; find the indentation of the next non-empty line - (catch 'stop - (while lines - (if (string-match "^\\* " (car lines)) (throw 'stop nil)) - (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) - (throw 'stop (setq ind (org-get-indentation (car lines))))) - (pop lines))) - (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) - (if (or (not (equal (char-before) ?\n)) - (not (equal (char-before (1- (point))) ?\n))) - (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) - (setq title (replace-match "" t t title)))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (string-width title) char) "\n") - (setq org-ascii-current-indentation '(0 . 0))))) - ;;;###autoload (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. @@ -4318,49 +3884,6 @@ lang=\"%s\" xml:lang=\"%s\"> nil)))) (defvar org-table-colgroup-info nil) -(defun org-format-table-ascii (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; 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)))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) (defvar org-table-number-regexp) ; defined in org-table.el (defun org-format-table-html (lines olines) diff --git a/lisp/org.el b/lisp/org.el index 4c4fcbb05..d5a2ab337 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -2911,14 +2911,14 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (re-search-forward org-table-any-border-regexp nil 1)))) (message "Mapping tables: done")) -;; Declare and autoload functions from org-exp.el +;; Declare and autoload functions from org-exp.el & Co (declare-function org-default-export-plist "org-exp") (declare-function org-infile-export-plist "org-exp") (declare-function org-get-current-options "org-exp") (eval-and-compile (org-autoload "org-exp" - '(org-export org-export-as-ascii org-export-visible + '(org-export org-export-visible org-insert-export-options-template org-export-as-html-and-open org-export-as-html-batch org-export-as-html-to-buffer org-replace-region-by-html org-export-region-as-html @@ -2927,6 +2927,11 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." org-table-clean-before-export org-export-icalendar-combine-agenda-files org-export-as-xoxo))) +(eval-and-compile + (org-autoload "org-ascii" + '(org-export-as-ascii))) + + ;; Declare and autoload functions from org-agenda.el (eval-and-compile @@ -14717,7 +14722,7 @@ With optional NODE, go directly to that node." (interactive) (mapc 'require '(org-agenda org-archive org-attach org-clock org-colview - org-exp org-id org-export-latex org-docbook + org-exp org-ascii org-id org-export-latex org-docbook org-publish org-remember org-table org-timer))) ;;;###autoload -- 2.11.4.GIT