[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[O] [RFC] Rewrite radio tables
|
From: |
Nicolas Goaziou |
|
Subject: |
[O] [RFC] Rewrite radio tables |
|
Date: |
Sun, 24 Aug 2014 21:25:57 +0200 |
Hello,
The following patch implements radio tables and `orgtbl-to-...'
functions using Org export engine. The implementation is probably not
totally backward compatible, though.
In particular, I suppressed :remove-nil-lines parameter, as I couldn't
make any sense out of it. If someone has a clear definition of its job,
and if that job is useful, I could implement it back.
Also, process does not dynamically bind `org-table-last-alignment' and
`org-table-last-column-widths' anymore. It should be possible to have
them back with some computations before starting the conversion, but,
unless they are vital, I'd rather not do it. `orgtbl-to-generic' is
tricky enough.
OTOH, I added :raw parameter, which allows to treat cells as strings and
not as Org syntax.
#+ORGTBL: SEND ... :raw nil
| *a* |
=>
...
\textbf{a}
...
#+ORGTBL: SEND ... :raw t
| *a* |
=>
...
*a*
...
I also added some specific parameters to translation functions,
e.g. :booktabs or :environment for `orgtbl-to-latex'. See docstring for
more information.
The patch comes with a test suite. However, it is no real use case.
Therefore, I'd appreciate some human testing before going further.
Feedback welcome.
Regards,
--
Nicolas Goaziou 0x80A93738
>From ac278792f9b6472f02bdd14e5472428bde083ccf Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Sun, 24 Aug 2014 01:31:56 +0200
Subject: [PATCH] org-table: Use "ox.el" internally for radio tables
* lisp/org-table.el (org-table-clean-before-export, orgtbl-get-fmt,
orgtbl-apply-fmt, orgtbl-eval-str, orgtbl-format-line,
orgtbl-format-section): Remove functions.
(org-table-clean-did-remove-column, *orgtbl-table*, *orgtbl-rtn*,
*orgtbl-hline*, *orgtbl-sep*, *orgtbl-default-fmt*, *orgtbl-fmt*,
*orgtbl-efmt*, *orgtbl-lfmt*, *orgtbl-llfmt*, *orgtbl-lstart*,
*orgtbl-llstart*, *orgtbl-lend*, *orgtbl-llend*): Remove variables.
(org-table-export, orgtbl-send-table): Apply function removal. Do not
set `org-table-last-alignment' and `org-table-last-column-widths'
anymore.
(org-table-to-lisp, orgtbl-send-replace-tbl): Small refactoring.
(org-table--to-generic-table, org-table--to-generic-row,
org-table--to-generic-cell): New functions.
(orgtbl-to-generic): Rewrite function. Handle :skip and :skipcols
parameters.
(orgtbl-to-latex, orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl,
orgtbl-to-unicode): Use new `orgtbl-to-generic' features.
* testing/lisp/test-org-table.el (test-org-table/to-generic,
test-org-table/to-latex, test-org-table/to-texinfo,
test-org-table/to-html, test-org-table/to-unicode,
test-org-table/send-region): New tests.
---
lisp/org-table.el | 1037 +++++++++++++++++++++-------------------
testing/lisp/test-org-table.el | 351 ++++++++++++++
2 files changed, 909 insertions(+), 479 deletions(-)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 06a1008..61be7d2 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -40,7 +40,9 @@
(declare-function org-export-string-as "ox"
(string backend &optional body-only ext-plist))
-(declare-function aa2u "ext:ascii-art-to-unicode" ())
+(declare-function org-export-create-backend "ox")
+(declare-function org-export-get-backend "ox" (name))
+
(declare-function calc-eval "calc" (str &optional separator &rest args))
(defvar orgtbl-mode) ; defined below
@@ -442,40 +444,6 @@ available parameters."
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
-(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
-(defun org-table-clean-before-export (lines &optional maybe-quoted)
- "Check if the table has a marking column.
-If yes remove the column and the special lines."
- (let ((special (if maybe-quoted
- "^[ \t]*| *\\\\?[\#!$*_^/ ] *|"
- "^[ \t]*| *[\#!$*_^/ ] *|"))
- (ignore (if maybe-quoted
- "^[ \t]*| *\\\\?[!$_^/] *|"
- "^[ \t]*| *[!$_^/] *|")))
- (setq org-table-clean-did-remove-column
- (not (memq nil
- (mapcar
- (lambda (line)
- (or (string-match org-table-hline-regexp line)
- (string-match special line)))
- lines))))
- (delq nil
- (mapcar
- (lambda (line)
- (cond
- ((or (org-table-colgroup-line-p line) ;; colgroup info
- (org-table-cookie-line-p line) ;; formatting cookies
- (and org-table-clean-did-remove-column
- (string-match ignore line))) ;; non-exportable data
- nil)
- ((and org-table-clean-did-remove-column
- (or (string-match "^\\([ \t]*\\)|-+\\+" line)
- (string-match "^\\([ \t]*\\)|[^|]*|" line)))
- ;; remove the first column
- (replace-match "\\1|" t nil line))
- (t line)))
- lines))))
-
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
@@ -624,8 +592,6 @@ are found, lines will be split on whitespace into fields."
(org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
-(defvar org-table-last-alignment)
-(defvar org-table-last-column-widths)
;;;###autoload
(defun org-table-export (&optional file format)
"Export table to a file, with configurable format.
@@ -643,77 +609,61 @@ extension of the given file name, and finally on the
variable
`org-table-export-default-format'."
(interactive)
(unless (org-at-table-p) (user-error "No table at point"))
- (org-table-align) ;; make sure we have everything we need
- (let* ((beg (org-table-begin))
- (end (org-table-end))
- (txt (buffer-substring-no-properties beg end))
- (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
- (formats '("orgtbl-to-tsv" "orgtbl-to-csv"
- "orgtbl-to-latex" "orgtbl-to-html"
- "orgtbl-to-generic" "orgtbl-to-texinfo"
- "orgtbl-to-orgtbl"))
- (format (or format
- (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
- buf deffmt-readable fileext)
+ (org-table-align) ; Make sure we have everything we need.
+ (let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t))))
(unless file
(setq file (read-file-name "Export table to: "))
(unless (or (not (file-exists-p file))
(y-or-n-p (format "Overwrite file %s? " file)))
(user-error "File not written")))
- (if (file-directory-p file)
- (user-error "This is a directory path, not a file"))
- (if (and (buffer-file-name)
- (equal (file-truename file)
- (file-truename (buffer-file-name))))
- (user-error "Please specify a file name that is different from
current"))
- (setq fileext (concat (file-name-extension file) "$"))
- (unless format
- (setq deffmt-readable
- (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f)
f)) formats)))
- org-table-export-default-format))
- (while (string-match "\t" deffmt-readable)
- (setq deffmt-readable (replace-match "\\t" t t deffmt-readable)))
- (while (string-match "\n" deffmt-readable)
- (setq deffmt-readable (replace-match "\\n" t t deffmt-readable)))
- (setq format (org-completing-read "Format: " formats nil nil
deffmt-readable)))
- (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
- (let* ((transform (intern (match-string 1 format)))
- (params (if (match-end 2)
- (read (concat "(" (match-string 2 format) ")"))))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[
\t]*")))
- (lines (org-table-clean-before-export lines))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0)))
-
- (unless (fboundp transform)
- (user-error "No such transformation function %s" transform))
- (setq txt (funcall transform table params))
-
- (with-current-buffer (find-file-noselect file)
- (setq buf (current-buffer))
- (erase-buffer)
- (fundamental-mode)
- (insert txt "\n")
- (save-buffer))
- (kill-buffer buf)
- (message "Export done."))
- (user-error "TABLE_EXPORT_FORMAT invalid"))))
+ (when (file-directory-p file)
+ (user-error "This is a directory path, not a file"))
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (file-equal-p
+ (file-truename file)
+ (file-truename (buffer-file-name (buffer-base-buffer)))))
+ (user-error "Please specify a file name that is different from current"))
+ (let ((fileext (concat (file-name-extension file) "$"))
+ (format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t))))
+ (unless format
+ (let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex"
+ "orgtbl-to-html" "orgtbl-to-generic"
+ "orgtbl-to-texinfo" "orgtbl-to-orgtbl"
+ "orgtbl-to-unicode"))
+ (deffmt-readable
+ (replace-regexp-in-string
+ "\t" "\\t"
+ (replace-regexp-in-string
+ "\n" "\\n"
+ (or (car (delq nil
+ (mapcar
+ (lambda (f)
+ (and (org-string-match-p fileext f) f))
+ formats)))
+ org-table-export-default-format)
+ t t) t t)))
+ (setq format
+ (org-completing-read
+ "Format: " formats nil nil deffmt-readable))))
+ (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
+ (let ((transform (intern (match-string 1 format)))
+ (params (and (match-end 2)
+ (read (concat "(" (match-string 2 format) ")"))))
+ (table (org-table-to-lisp
+ (buffer-substring-no-properties
+ (org-table-begin) (org-table-end)))))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (let (buf)
+ (with-current-buffer (find-file-noselect file)
+ (setq buf (current-buffer))
+ (erase-buffer)
+ (fundamental-mode)
+ (insert (funcall transform table params) "\n")
+ (save-buffer))
+ (kill-buffer buf))
+ (message "Export done."))
+ (user-error "TABLE_EXPORT_FORMAT invalid")))))
(defvar org-table-aligned-begin-marker (make-marker)
"Marker at the beginning of the table last aligned.
@@ -4499,15 +4449,12 @@ a radio table."
(unless (re-search-forward
(concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
(user-error "Don't know where to insert translated table"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (save-excursion
- (let ((beg (point)))
- (unless (re-search-forward
- (concat "END +RECEIVE +ORGTBL +" name) nil t)
- (user-error "Cannot find end of insertion region"))
- (beginning-of-line 1)
- (delete-region beg (point))))
+ (let ((beg (line-beginning-position 2)))
+ (unless (re-search-forward
+ (concat "END +RECEIVE +ORGTBL +" name) nil t)
+ (user-error "Cannot find end of insertion region"))
+ (beginning-of-line)
+ (delete-region beg (point)))
(insert txt "\n")))
;;;###autoload
@@ -4516,76 +4463,43 @@ a radio table."
The structure will be a list. Each item is either the symbol `hline'
for a horizontal separator line, or a list of field values as strings.
The table is taken from the parameter TXT, or from the buffer at point."
- (unless txt
- (unless (org-at-table-p)
- (user-error "No table at point")))
- (let* ((txt (or txt
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end))))
- (lines (org-split-string txt "[ \t]*\n[ \t]*")))
-
- (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- lines)))
+ (unless (or txt (org-at-table-p)) (user-error "No table at point"))
+ (let ((txt (or txt
+ (buffer-substring-no-properties (org-table-begin)
+ (org-table-end)))))
+ (mapcar (lambda (x)
+ (if (string-match org-table-hline-regexp x) 'hline
+ (org-split-string (org-trim x) "\\s-*|\\s-*")))
+ (org-split-string txt "[ \t]*\n[ \t]*"))))
(defun orgtbl-send-table (&optional maybe)
- "Send a transformed version of this table to the receiver position.
-With argument MAYBE, fail quietly if no transformation is defined for
-this table."
+ "Send a transformed version of table at point to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined
+for this table."
(interactive)
(catch 'exit
(unless (org-at-table-p) (user-error "Not at a table"))
;; when non-interactive, we assume align has just happened.
(when (org-called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
- (txt (buffer-substring-no-properties (org-table-begin)
- (org-table-end)))
+ (table (org-table-to-lisp
+ (buffer-substring-no-properties (org-table-begin)
+ (org-table-end))))
(ntbl 0))
- (unless dests (if maybe (throw 'exit nil)
- (user-error "Don't know how to transform this table")))
+ (unless dests
+ (if maybe (throw 'exit nil)
+ (user-error "Don't know how to transform this table")))
(dolist (dest dests)
- (let* ((name (plist-get dest :name))
- (transform (plist-get dest :transform))
- (params (plist-get dest :params))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (no-escape (plist-get params :no-escape))
- beg
- (lines (org-table-clean-before-export
- (nthcdr (or skip 0)
- (org-split-string txt "[ \t]*\n[ \t]*"))))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (lines (if no-escape lines
- (mapcar (lambda(l) (replace-regexp-in-string
- "\\([&%#_^]\\)" "\\\\\\1{}" l))
lines)))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0))
- (txt (if (fboundp transform)
- (funcall transform table params)
- (user-error "No such transformation function %s"
transform))))
- (orgtbl-send-replace-tbl name txt))
- (setq ntbl (1+ ntbl)))
+ (let ((name (plist-get dest :name))
+ (transform (plist-get dest :transform))
+ (params (plist-get dest :params)))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (orgtbl-send-replace-tbl name (funcall transform table params)))
+ (incf ntbl))
(message "Table converted and installed at %d receiver location%s"
ntbl (if (> ntbl 1) "s" ""))
- (if (> ntbl 0)
- ntbl
- nil))))
+ (and (> ntbl 0) ntbl))))
(defun org-remove-by-index (list indices &optional i0)
"Remove the elements in LIST with indices in INDICES.
@@ -4635,330 +4549,489 @@ First element has index 0, or I0 if given."
(insert txt)
(goto-char pos)))
-;; Dynamically bound input and output for table formatting.
-(defvar *orgtbl-table* nil
- "Carries the current table through formatting routines.")
-(defvar *orgtbl-rtn* nil
- "Formatting routines push the output lines here.")
-;; Formatting parameters for the current table section.
-(defvar *orgtbl-hline* nil "Text used for horizontal lines.")
-(defvar *orgtbl-sep* nil "Text used as a column separator.")
-(defvar *orgtbl-default-fmt* nil "Default format for each entry.")
-(defvar *orgtbl-fmt* nil "Format for each entry.")
-(defvar *orgtbl-efmt* nil "Format for numbers.")
-(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.")
-(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.")
-(defvar *orgtbl-lstart* nil "Text starting a row.")
-(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.")
-(defvar *orgtbl-lend* nil "Text ending a row.")
-(defvar *orgtbl-llend* nil "Specializes lend for the last row.")
-
-(defsubst orgtbl-get-fmt (fmt i)
- "Retrieve the format from FMT corresponding to the Ith column."
- (if (and (not (functionp fmt)) (consp fmt))
- (plist-get fmt i)
- fmt))
-
-(defsubst orgtbl-apply-fmt (fmt &rest args)
- "Apply format FMT to arguments ARGS.
-When FMT is nil, return the first argument from ARGS."
- (cond ((functionp fmt) (apply fmt args))
- (fmt (apply 'format fmt args))
- (args (car args))
- (t args)))
-
-(defsubst orgtbl-eval-str (str)
- "If STR is a function, evaluate it with no arguments."
- (if (functionp str)
- (funcall str)
- str))
-
-(defun orgtbl-format-line (line)
- "Format LINE as a table row."
- (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*))
- (let* ((i 0)
- (line
- (mapcar
- (lambda (f)
- (setq i (1+ i))
- (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i))
- (f (if (and efmt (string-match orgtbl-exp-regexp f))
- (orgtbl-apply-fmt efmt (match-string 1 f)
- (match-string 2 f))
- f)))
- (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i)
- *orgtbl-default-fmt*)
- f)))
- line)))
- (push (if *orgtbl-lfmt*
- (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line)
- (concat (orgtbl-eval-str *orgtbl-lstart*)
- (mapconcat 'identity line *orgtbl-sep*)
- (orgtbl-eval-str *orgtbl-lend*)))
- *orgtbl-rtn*))))
-
-(defun orgtbl-format-section (section-stopper)
- "Format lines until the first occurrence of SECTION-STOPPER."
- (let (prevline)
- (progn
- (while (not (eq (car *orgtbl-table*) section-stopper))
- (if prevline (orgtbl-format-line prevline))
- (setq prevline (pop *orgtbl-table*)))
- (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*)
- (*orgtbl-lend* *orgtbl-llend*)
- (*orgtbl-lfmt* *orgtbl-llfmt*))
- (orgtbl-format-line prevline))))))
-
;;;###autoload
-(defun orgtbl-to-generic (table params &optional backend)
+(defun orgtbl-to-generic (table params)
"Convert the orgtbl-mode TABLE to some other format.
+
This generic routine can be used for many standard cases.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-A third optional argument BACKEND can be used to convert the content of
-the cells using a specific export back-end.
-For the generic converter, some parameters are obligatory: you need to
-specify either :lfmt, or all of (:lstart :lend :sep).
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that
+line. PARAMS is a property list of parameters that can
+influence the conversion.
Valid parameters are:
-:splice When set to t, return only table body lines, don't wrap
- them into :tstart and :tend. Default is nil. When :splice
- is non-nil, this also means that the exporter should not look
- for and interpret header and footer sections.
+:backend
+
+ Export back-end used as a basis to transcode elements of the
+ table, when no specific parameter applies to it. It is also
+ used to translate cells contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, return only table body lines (i.e, skip header
+ section). Also don't wrap them into :tstart and :tend.
+ Default is nil.
+
+:skip
+
+ When set to an integer N, skip the first N lines of the table.
+ Horizontal separation lines do count for this parameter!
+
+:skipcols
-:hline String to be inserted on horizontal separation lines.
- May be nil to ignore hlines.
+ List of columns that should be skipped. If the table has
+ a column with calculation marks, that column is automatically
+ discarded as well. Please note that the translator function
+ sees the table after the removal of these columns, the function
+ never knows that there have been additional columns.
-:sep Separator between two fields
-:remove-nil-lines Do not include lines that evaluate to nil.
+:hline
+
+ String to be inserted on horizontal separation lines. May
+ be nil to ignore hlines.
+
+:sep
+
+ Separator between two fields, as a string.
Each in the following group may be either a string or a function
of no arguments returning a string:
-:tstart String to start the table. Ignored when :splice is t.
-:tend String to end the table. Ignored when :splice is t.
-:lstart String to start a new table line.
-:llstart String to start the last table line, defaults to :lstart.
-:lend String to end a table line
-:llend String to end the last table line, defaults to :lend.
-
-Each in the following group may be a string, a function of one
-argument (the field or line) returning a string, or a plist
-mapping columns to either of the above:
-
-:lfmt Format for entire line, with enough %s to capture all fields.
- If this is present, :lstart, :lend, and :sep are ignored.
-:llfmt Format for the entire last line, defaults to :lfmt.
-:fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in dollars, you could use :fmt \"$%s$\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
-:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
- Same as above, specific for the header lines in the table.
- All lines before the first hline are treated as header.
- If any of these is not present, the data line value is used.
+:tstart
+
+ String to start the table. Ignored when :splice is t.
+
+:tend
+
+ String to end the table. Ignored when :splice is t.
+
+:lstart
+
+ String to start a new table line.
+
+:llstart
+
+ String to start the last table line, defaults to :lstart.
+
+:lend
+
+ String to end a table line.
+
+:llend
+
+ String to end the last table line, defaults to :lend.
+
+Each in the following group may be a string or a function of
+several arguments (one for each cell in row) returning a string:
+
+:lfmt
+
+ Format for entire line, with enough %s to capture all fields.
+ If this is present, :lstart, :lend, and :sep are ignored.
+
+:llfmt
+
+ Format for the entire last line, defaults to :lfmt.
+
+:fmt
+
+ A format to be used to wrap the field, should contain %s for
+ the original field value. For example, to wrap everything in
+ dollars, you could use :fmt \"$%s$\". This may also be
+ a property list with column numbers and format strings, or
+ functions, e.g.,
+
+ \(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+
+:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
+
+ Same as above, specific for the header lines in the table.
+ All lines before the first hline are treated as header. If
+ any of these is not present, the data line value is used.
This may be either a string or a function of two arguments:
-:efmt Use this format to print numbers with exponentials.
- The format should have %s twice for inserting mantissa
- and exponent, for example \"%s\\\\times10^{%s}\". This
- may also be a property list with column numbers and
- formats. :fmt will still be applied after :efmt.
-
-In addition to this, the parameters :skip and :skipcols are always handled
-directly by `orgtbl-send-table'. See manual."
- (let* ((splicep (plist-get params :splice))
- (hline (plist-get params :hline))
- (skipheadrule (plist-get params :skipheadrule))
- (remove-nil-linesp (plist-get params :remove-nil-lines))
- (remove-newlines (plist-get params :remove-newlines))
- (*orgtbl-hline* hline)
- (*orgtbl-table* table)
- (*orgtbl-sep* (plist-get params :sep))
- (*orgtbl-efmt* (plist-get params :efmt))
- (*orgtbl-lstart* (plist-get params :lstart))
- (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*))
- (*orgtbl-lend* (plist-get params :lend))
- (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*))
- (*orgtbl-lfmt* (plist-get params :lfmt))
- (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
- (*orgtbl-fmt* (plist-get params :fmt))
- *orgtbl-rtn*)
- ;; Convert cells content to backend BACKEND
- (when backend
- (setq *orgtbl-table*
- (mapcar
- (lambda(r)
- (if (listp r)
- (mapcar
- (lambda (c)
- (org-trim (org-export-string-as c backend t
'(:with-tables t))))
- r)
- r))
- *orgtbl-table*)))
- ;; Put header
- (unless splicep
- (when (plist-member params :tstart)
- (let ((tstart (orgtbl-eval-str (plist-get params :tstart))))
- (if tstart (push tstart *orgtbl-rtn*)))))
- ;; If we have a heading, format it and handle the trailing hline.
- (if (and (not splicep)
- (or (consp (car *orgtbl-table*))
- (consp (nth 1 *orgtbl-table*)))
- (memq 'hline (cdr *orgtbl-table*)))
- (progn
- (when (eq 'hline (car *orgtbl-table*))
- ;; There is a hline before the first data line
- (and hline (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*))
- (let* ((*orgtbl-lstart* (or (plist-get params :hlstart)
- *orgtbl-lstart*))
- (*orgtbl-llstart* (or (plist-get params :hllstart)
- *orgtbl-llstart*))
- (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*))
- (*orgtbl-llend* (or (plist-get params :hllend)
- (plist-get params :hlend) *orgtbl-llend*))
- (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*))
- (*orgtbl-llfmt* (or (plist-get params :hllfmt)
- (plist-get params :hlfmt) *orgtbl-llfmt*))
- (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*))
- (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*)))
- (orgtbl-format-section 'hline))
- (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*)))
- ;; Now format the main section.
- (orgtbl-format-section nil)
- (unless splicep
- (when (plist-member params :tend)
- (let ((tend (orgtbl-eval-str (plist-get params :tend))))
- (if tend (push tend *orgtbl-rtn*)))))
- (mapconcat (if remove-newlines
- (lambda (tend)
- (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
- 'identity)
- (nreverse (if remove-nil-linesp
- (remq nil *orgtbl-rtn*)
- *orgtbl-rtn*)) "\n")))
+:efmt
+
+ Use this format to print numbers with exponential. The format
+ should have %s twice for inserting mantissa and exponent, for
+ example \"%s\\\\times10^{%s}\". This may also be a property
+ list with column numbers and format strings or functions.
+ :fmt will still be applied after :efmt."
+ (let ((backend (plist-get params :backend)))
+ (when (and backend (symbolp backend) (not (org-export-get-backend
backend)))
+ (user-error "Unknown :backend value"))
+ (when (or (not backend) (plist-get params :raw)) (require 'ox-org))
+ (org-trim
+ (org-export-string-as
+ ;; Return TABLE as Org syntax. Tolerate non-string cells.
+ (with-output-to-string
+ (dolist (e table)
+ (cond ((eq e 'hline) (princ "|--\n"))
+ ((consp e)
+ (princ "| ") (dolist (c e) (princ c) (princ " |"))
+ (princ "\n")))))
+ ;; Build a custom back-end according to PARAMS. Before defining
+ ;; a translator, check if there is anything to do. When there
+ ;; isn't, let BACKEND handle the element.
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :filters
+ '((:filter-parse-tree
+ ;; Handle :skip parameter.
+ (lambda (tree backend info)
+ (let ((skip (plist-get info :skip)))
+ (when skip
+ (unless (wholenump skip) (user-error "Wrong :skip value"))
+ (let ((n 0))
+ (org-element-map tree 'table-row
+ (lambda (row)
+ (if (>= n skip) t
+ (org-element-extract-element row)
+ (incf n)
+ nil))
+ info t))
+ tree)))
+ ;; Handle :skipcols parameter.
+ (lambda (tree backend info)
+ (let ((skipcols (plist-get info :skipcols)))
+ (when skipcols
+ (unless (consp skipcols) (user-error "Wrong :skipcols value"))
+ (org-element-map tree 'table
+ (lambda (table)
+ (let ((specialp
+ (org-export-table-has-special-column-p table)))
+ (dolist (row (org-element-contents table))
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((c 1))
+ (dolist (cell (nthcdr (if specialp 1 0)
+ (org-element-contents row)))
+ (when (memq c skipcols)
+ (org-element-extract-element cell))
+ (incf c)))))))
+ info)
+ tree)))))
+ :transcoders
+ `((table . ,(org-table--to-generic-table params))
+ (table-row . ,(org-table--to-generic-row params))
+ (table-cell . ,(org-table--to-generic-cell params))
+ ;; Section. Return contents to avoid garbage around table.
+ (section . (lambda (s c i) c))))
+ 'body-only (org-combine-plists params '(:with-tables t))))))
+
+(defun org-table--to-generic-table (params)
+ "Return custom table transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more information.
+Return nil if no transcoder is needed."
+ (let ((backend (plist-get params :backend))
+ (splice (plist-get params :splice))
+ (tstart (plist-get params :tstart))
+ (tend (plist-get params :tend)))
+ `(lambda (table contents info)
+ (concat ,@(cond ((or splice (not tstart)) nil)
+ ((functionp tstart) `((funcall ',tstart) "\n"))
+ ((stringp tstart) `(,tstart "\n"))
+ (t (user-error "Wrong :tstart value")))
+ ,(if (and backend (not (or tstart tend splice)))
+ `(org-export-with-backend ',backend table contents info)
+ 'contents)
+ ,(cond ((or splice (not tend)) nil)
+ ((functionp tend) `(funcall ',tend))
+ ((stringp tend) tend)
+ (t (user-error "Wrong :tend value")))))))
+
+(defun org-table--to-generic-row (params)
+ "Return custom table row transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (lstart (plist-get params :lstart))
+ (llstart (or (plist-get params :llstart) lstart))
+ (hlstart (or (plist-get params :hlstart) lstart))
+ (hllstart (or (plist-get params :hllstart) hlstart))
+ (lend (plist-get params :lend))
+ (llend (or (plist-get params :llend) lend))
+ (hlend (or (plist-get params :hlend) lend))
+ (hllend (or (plist-get params :hllend) hlend))
+ (lfmt (plist-get params :lfmt))
+ (llfmt (or (plist-get params :llfmt) lfmt))
+ (hlfmt (or (plist-get params :hlfmt) lfmt))
+ (hllfmt (or (plist-get params :hllfmt) hlfmt))
+ (splice (plist-get params :splice)))
+ `(lambda (row contents info)
+ (if (eq (org-element-property :type row) 'rule)
+ ,(cond ((plist-member params :hline) (plist-get params :hline))
+ (backend `(org-export-with-backend ',backend row info)))
+ (let ((headerp
+ (and (org-export-table-has-header-p
+ (org-element-property :parent row) info)
+ (= (org-export-table-row-group row info) 1)))
+ (lastp (not (org-export-get-next-element row info)))
+ (last-header-p (org-export-table-row-ends-header-p row info)))
+ (when (and contents ,(or (not splice) '(not headerp)))
+ ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
+ ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
+ ;; `:lstart', `:lend' and their relatives.
+ ,(let ((use
+ (lambda (v p)
+ `(apply
+ ,@(cond
+ ((functionp v) `(',v))
+ ((stringp v) `(#'format ,v))
+ (t (user-error "Wrong %s value" p)))
+ (org-element-map row 'table-cell
+ (lambda (cell)
+ ;; Use `org-export-data-with-backend'
+ ;; instead of `org-export-data' to avoid
+ ;; cached values, which
+ ;; ignore :orgtbl-ignore-sep parameter.
+ (org-export-data-with-backend
+ cell
+ (plist-get info :back-end)
+ (org-combine-plists
+ info '(:orgtbl-ignore-sep t))))
+ info)))))
+ `(cond
+ ,(and hllfmt `(last-header-p ,(funcall use hllfmt ":hllfmt")))
+ ,(and hlfmt `(headerp ,(funcall use hlfmt ":hlfmt")))
+ ,(and llfmt `(lastp ,(funcall use llfmt ":llfmt")))
+ (t
+ ,(if lfmt (funcall use lfmt ":lfmt")
+ (let ((use
+ (lambda (v p)
+ (cond ((null v) nil)
+ ((functionp v) `(funcall ',v))
+ ((stringp v) v)
+ (t (user-error "Wrong %s value" p))))))
+ `(concat
+ (cond
+ ,(and (or hllstart hllend)
+ `(last-header-p
+ (concat ,(funcall use hllstart ":hllstart")
+ contents
+ ,(funcall use hllend ":hllend"))))
+ ,(and (or hlstart hlend)
+ `(headerp
+ (concat ,(funcall use hlstart ":hlstart")
+ contents
+ ,(funcall use hlend ":hlend"))))
+ ,(and (or llstart llend)
+ `(lastp
+ (concat ,(funcall use llstart ":llstart")
+ contents
+ ,(funcall use llend ":llend"))))
+ (t
+ ,(cond
+ ((or lstart lend)
+ `(concat ,(funcall use lstart ":lstart")
+ contents
+ ,(funcall use lend ":lend")))
+ (backend
+ `(org-export-with-backend
+ ',backend row contents info))
+ (t 'contents))))))))))))))))
+
+(defun org-table--to-generic-cell (params)
+ "Return custom table cell transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (efmt (plist-get params :efmt))
+ (fmt (plist-get params :fmt))
+ (hfmt (or (plist-get params :hfmt) fmt))
+ (sep (plist-get params :sep))
+ (hsep (or (plist-get params :hsep) sep)))
+ `(lambda (cell contents info)
+ (let ((column (1+ (cdr (org-export-table-cell-address cell info))))
+ (headerp (= (org-export-table-row-group
+ (org-export-get-parent-element cell) info)
+ 1))
+ (lastp (not (org-export-get-next-element cell info))))
+ ;; Make sure that contents are exported as Org data when :raw
+ ;; parameter is non-nil.
+ ,(when (and backend (plist-get params :raw))
+ `(setq contents
+ (org-export-data-with-backend
+ (org-element-contents cell) 'org info)))
+ (when contents
+ ;; Check if we can apply `:efmt' on CONTENTS. If `:efmt'
+ ;; binds columns to format strings or functions, first
+ ;; get the right one.
+ ,(when efmt
+ `(when (string-match orgtbl-exp-regexp contents)
+ (let ((mantissa (match-string 1 contents))
+ (exponent (match-string 2 contents)))
+ (setq contents
+ ,(cond
+ ((stringp efmt)
+ `(format ,efmt mantissa exponent))
+ ((functionp efmt)
+ `(funcall #',efmt mantissa exponent))
+ ((consp efmt)
+ `(let ((efmt (cadr (memq column ',efmt))))
+ (cond
+ ((null efmt) contents)
+ ((stringp efmt)
+ (format efmt mantissa exponent))
+ ((functionp efmt)
+ (funcall efmt mantissa exponent))
+ (t (user-error "Wrong :efmt value")))))
+ (t (user-error "Wrong :efmt value")))))))
+ ;; Check if we can apply FMT (or HFMT) on CONTENTS. If
+ ;; FMT binds columns to format strings, first get the
+ ;; right one.
+ ,(when hfmt
+ (let ((value
+ (lambda (v p)
+ (cond
+ ((null v) 'contents)
+ ((functionp v) `(funcall #',v contents))
+ ((stringp v) `(format ,v contents))
+ ((consp v)
+ `(let ((fmt (cadr (memq column ',v))))
+ (cond
+ ((null fmt) contents)
+ ((stringp fmt) (format fmt contents))
+ ((functionp fmt) (funcall fmt contents))
+ (t (user-error "Wrong %s value" p)))))
+ (t (user-error "Wrong %s value" p))))))
+ `(setq contents
+ (if headerp ,(funcall value hfmt ":hfmt")
+ ,(funcall value fmt ":fmt"))))))
+ ;; If a separator is provided, use it instead of BACKEND's.
+ ;; Separators are ignored when LFMT (or equivalent) is
+ ;; provided.
+ (if (and ,hsep
+ (not lastp)
+ (not (plist-get info :orgtbl-ignore-sep)))
+ (concat contents (or (and headerp ,hsep) ,sep))
+ ,(if (not backend) 'contents
+ `(org-export-with-backend ',backend cell contents info)))))))
;;;###autoload
(defun orgtbl-to-tsv (table params)
"Convert the orgtbl-mode table to TAB separated material."
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
+
;;;###autoload
(defun orgtbl-to-csv (table params)
"Convert the orgtbl-mode table to CSV material.
This does take care of the proper quoting of fields with comma or quotes."
- (orgtbl-to-generic table (org-combine-plists
- '(:sep "," :fmt org-quote-csv-field)
- params)))
+ (orgtbl-to-generic table
+ (org-combine-plists '(:sep "," :fmt org-quote-csv-field)
+ params)))
;;;###autoload
(defun orgtbl-to-latex (table params)
"Convert the orgtbl-mode TABLE to LaTeX.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-LaTeX are:
-
-:splice When set to t, return only table body lines, don't wrap
- them into a tabular environment. Default is nil.
-
-:fmt A format to be used to wrap the field, should contain %s for the
- original field value. For example, to wrap everything in dollars,
- use :fmt \"$%s$\". This may also be a property list with column
- numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
- The format may also be a function that formats its one argument.
-
-:efmt Format for transforming numbers with exponentials. The format
- should have %s twice for inserting mantissa and exponent, for
- example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\".
- This may also be a property list with column numbers and formats.
- The format may also be a function that formats its two arguments.
-
-:llend If you find too much space below the last line of a table,
- pass a value of \"\" for :llend to suppress the final \\\\.
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (params2
- (list
- :tstart (concat "\\begin{tabular}{" alignment "}")
- :tend "\\end{tabular}"
- :lstart "" :lend " \\\\" :sep " & "
- :efmt "%s\\,(%s)" :hline "\\hline")))
- (require 'ox-latex)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'latex)))
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. Additionally, it is also possible to use the
+following parameters:
+
+:booktabs
+
+ When non-nil, use formal \"booktabs\" style.
+
+:environment
+
+ Specify environment to use, as a string. If you use
+ \"longtable\", you may also want to specify :language property,
+ as a string, to get proper continuation strings.
+
+The general parameters :skip and :skipcols have already been
+applied when this function is called."
+ (require 'ox-latex)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'latex
+ :latex-default-table-mode 'table
+ :latex-tables-centered nil
+ :latex-tables-booktabs (plist-get params :booktabs)
+ :latex-table-scientific-notation (plist-get params :efmt)
+ :latex-default-table-environment
+ (or (plist-get params :environment) "tabular"))
+ params
+ '(:efmt nil))))
;;;###autoload
(defun orgtbl-to-html (table params)
"Convert the orgtbl-mode TABLE to HTML.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Currently this function recognizes the following parameters:
-:splice When set to t, return only table body lines, don't wrap
- them into a <table> environment. Default is nil.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. Additionally, it is also possible to use the
+following parameter:
-The general parameters :skip and :skipcols have already been applied when
-this function is called. The function does *not* use `orgtbl-to-generic',
-so you cannot specify parameters for it."
+:attributes
+
+ Attributes and values, as a plist, which will be used in
+ <table> tag.
+
+The general parameters :skip and :skipcols have already been
+applied when this function is called."
(require 'ox-html)
- (let ((output (org-export-string-as
- (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t))))
- (if (not (plist-get params :splice)) output
- (org-trim
- (replace-regexp-in-string
- "\\`<table .*>\n" ""
- (replace-regexp-in-string "</table>\n*\\'" "" output))))))
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'html
+ :html-table-data-tags '("<td%s>" . "</td>")
+ :html-table-use-header-tags-for-first-column nil
+ :html-table-align-individual-fields t
+ :html-table-row-tags '("<tr>" . "</tr>")
+ :html-table-attributes
+ (if (plist-member params :attributes)
+ (plist-get params :attributes)
+ '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups"
+ :frame "hsides")))
+ params)))
;;;###autoload
(defun orgtbl-to-texinfo (table params)
- "Convert the orgtbl-mode TABLE to TeXInfo.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-TeXInfo are:
-
-:splice nil/t When set to t, return only table body lines, don't wrap
- them into a multitable environment. Default is nil.
-
-:fmt fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
- Each format also may be a function that formats its one
- argument.
-
-:cf \"f1 f2..\" The column fractions for the table. By default these
- are computed automatically from the width of the columns
- under org-mode.
+ "Convert the orgtbl-mode TABLE to Texinfo.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. Additionally, it is also possible to use the
+following parameter:
+
+:columns
+
+ Column widths, as a string. When providing column fractions,
+ \"@columnfractions\" command can be omitted.
The general parameters :skip and :skipcols have already been applied when
this function is called."
- (let* ((total (float (apply '+ org-table-last-column-widths)))
- (colfrac (or (plist-get params :cf)
- (mapconcat
- (lambda (x) (format "%.3f" (/ (float x) total)))
- org-table-last-column-widths " ")))
- (params2
- (list
- :tstart (concat "@multitable @columnfractions " colfrac)
- :tend "@end multitable"
- :lstart "@item " :lend "" :sep " @tab "
- :hlstart "@headitem ")))
- (require 'ox-texinfo)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo)))
+ (require 'ox-texinfo)
+ (let ((output
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'texinfo
+ :texinfo-tables-verbatim nil
+ :latex-table-scientific-notation (plist-get params :efmt))
+ params
+ (list :efmt nil))))
+ (columns (let ((w (plist-get params :columns)))
+ (cond ((not w) nil)
+ ((org-string-match-p "{\\|@columnfractions " w) w)
+ (t (concat "@columnfractions " w))))))
+ (if (not columns) output
+ (replace-regexp-in-string
+ "@multitable \\(.*\\)" columns output t nil 1))))
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
@@ -4967,21 +5040,8 @@ Useful when slicing one table into many. The :hline,
:sep,
:lstart, and :lend provide orgtbl framing. The default nil :tstart
and :tend suppress strings without splicing; they can be set to
provide ORGTBL directives for the generated table."
- (let* ((params2
- (list
- :remove-newlines t
- :tstart nil :tend nil
- :hline "|---"
- :sep " | "
- :lstart "| "
- :lend " |"))
- (params (org-combine-plists params2 params)))
- (with-temp-buffer
- (insert (orgtbl-to-generic table params))
- (goto-char (point-min))
- (while (re-search-forward org-table-hline-regexp nil t)
- (org-table-align))
- (buffer-substring 1 (buffer-size)))))
+ (require 'ox-org)
+ (orgtbl-to-generic table (org-combine-plists (list :backend 'org))))
(defun orgtbl-to-table.el (table params)
"Convert the orgtbl-mode TABLE into a table.el table."
@@ -4994,19 +5054,38 @@ provide ORGTBL directives for the generated table."
(defun orgtbl-to-unicode (table params)
"Convert the orgtbl-mode TABLE into a table with unicode characters.
-You need the ascii-art-to-unicode.el package for this. You can download
-it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.";
- (with-temp-buffer
- (insert (orgtbl-to-table.el table params))
- (goto-char (point-min))
- (if (or (featurep 'ascii-art-to-unicode)
- (require 'ascii-art-to-unicode nil t))
- (aa2u)
- (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l)))
org-stored-links))
- (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el";
- "Link to ascii-art-to-unicode.el") org-stored-links))
- (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to
insert the link to it)"))
- (buffer-string)))
+
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. Additionally, it is also possible to use the
+following parameters:
+
+:ascii-art
+
+ When non-nil, use \"ascii-art-to-unicode\" package to translate
+ the table. You can download it here:
+ http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
+
+:narrow
+
+ When non-nil, narrow columns width than provided width cookie,
+ using \"=>\" as an ellipsis, just like in an Org mode buffer.
+
+The general parameters :skip and :skipcols have already been
+applied when this function is called."
+ (require 'ox-ascii)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'ascii
+ :ascii-charset 'utf-8
+ :ascii-table-keep-all-vertical-lines (plist-get params :)
+ :ascii-table-widen-columns (not (plist-get params :narrow))
+ :ascii-table-use-ascii-art (plist-get params :ascii-art))
+ params)))
(defun org-table-get-remote-range (name-or-id form)
"Get a field value or a list of values in a range from table at ID.
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 40101be..d99d735 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -1168,6 +1168,357 @@ See also `test-org-table/copy-field'."
(should (string= got
expect)))))
+;;; Radio Tables
+
+(ert-deftest test-org-table/to-generic ()
+ "Test `orgtbl-to-generic' specifications."
+ ;; Test :splice parameter.
+ (should
+ (equal "b"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:splice t))))
+ (should
+ (equal "a\nb"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |") '(:splice t))))
+ ;; Test :hline parameter.
+ (should
+ (equal "a\nb"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:hline nil))))
+ (should
+ (equal "a\n~\nb"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:hline "~"))))
+ ;; Test :sep parameter.
+ (should
+ (equal "a!b\nc!d"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:sep "!"))))
+ ;; Test :hsep parameter.
+ (should
+ (equal "a!b\nc?d"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:sep "?" :hsep "!"))))
+ ;; Test :tstart parameter.
+ (should
+ (equal "<begin>\na"
+ (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
+ (should
+ (equal "<begin>\na"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:tstart (lambda () "<begin>")))))
+ (should
+ (equal "a"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:tstart "<begin>" :splice t))))
+ ;; Test :tend parameter.
+ (should
+ (equal "a\n<end>"
+ (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
+ (should
+ (equal "a\n<end>"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:tend (lambda () "<end>")))))
+ (should
+ (equal "a"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:tend "<end>" :splice t))))
+ ;; Test :lstart parameter.
+ (should
+ (equal "> a"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a |") '(:lstart "> "))))
+ (should
+ (equal "> a"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:lstart (lambda () "> ")))))
+ ;; Test :llstart parameter.
+ (should
+ (equal "> a\n>> b"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:lstart "> " :llstart ">> "))))
+ ;; Test :hlstart parameter.
+ (should
+ (equal "!> a\n> b"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:lstart "> " :hlstart "!> "))))
+ ;; Test :hllstart parameter.
+ (should
+ (equal "!> a\n!!> b\n> c"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
+ '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
+ ;; Test :lend parameter.
+ (should
+ (equal "a <"
+ (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
+ ;; Test :llend parameter.
+ (should
+ (equal "a <\nb <<"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:lend " <" :llend " <<"))))
+ ;; Test :hlend parameter.
+ (should
+ (equal "a <!\nb <"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:lend " <" :hlend " <!"))))
+ ;; Test :hllend parameter.
+ (should
+ (equal "a <!\nb <!!\nc <"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
+ '(:lend " <" :hlend " <!" :hllend " <!!"))))
+ ;; Test :lfmt parameter.
+ (should
+ (equal "a!b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:lfmt "%s!%s"))))
+ (should
+ (equal "a+b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:lfmt (lambda (c1 c2) (concat c1 "+" c2))))))
+ (should
+ (equal "a!b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
+ ;; Test :llfmt parameter.
+ (should
+ (equal "a!b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:llfmt "%s!%s"))))
+ (should
+ (equal "a!b\nc+d"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n| c | d |")
+ '(:lfmt "%s!%s" :llfmt (lambda (c1 c2) (concat c1 "+" c2))))))
+ (should
+ (equal "a!b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
+ ;; Test :hlfmt parameter.
+ (should
+ (equal "a!b\ncd"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hlfmt "%s!%s"))))
+ (should
+ (equal "a+b\ncd"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hlfmt (lambda (c1 c2) (concat c1 "+" c2))))))
+ (should
+ (equal "a!b\n>c d<"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
+ ;; Test :hllfmt parameter.
+ (should
+ (equal "a!b\ncd"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hllfmt "%s!%s"))))
+ (should
+ (equal "a+b\ncd"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hllfmt (lambda (c1 c2) (concat c1 "+" c2))))))
+ (should
+ (equal "a!b\n>c d<"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
+ '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
+ ;; Test :fmt parameter.
+ (should
+ (equal ">a<\n>b<"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:fmt ">%s<"))))
+ (should
+ (equal ">a<b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
+ (should
+ (equal "a b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:fmt (2 " %s")))))
+ (should
+ (equal ">a<"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:fmt (lambda (c) (format ">%s<" c))))))
+ ;; Test :hfmt parameter.
+ (should
+ (equal ">a<\nb"
+ (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
+ '(:hfmt ">%s<"))))
+ (should
+ (equal ">a<b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:hfmt (1 ">%s<" 2 identity)))))
+ (should
+ (equal "a b"
+ (orgtbl-to-generic (org-table-to-lisp "| a | b |")
+ '(:hfmt (2 " %s")))))
+ (should
+ (equal ">a<"
+ (orgtbl-to-generic (org-table-to-lisp "| a |")
+ '(:hfmt (lambda (c) (format ">%s<" c))))))
+ ;; Test :efmt parameter.
+ (should
+ (equal "2x10^3"
+ (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
+ '(:efmt "%sx10^%s"))))
+ (should
+ (equal "2x10^3"
+ (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
+ '(:efmt (lambda (m e) (concat m "x10^" e))))))
+ (should
+ (equal "2x10^3"
+ (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
+ '(:efmt (1 "%sx10^%s")))))
+ (should
+ (equal "2x10^3"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| 2e3 |")
+ '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
+ (should
+ (equal "2e3"
+ (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
+ ;; Test :skip parameter.
+ (should
+ (equal "cd"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
+ '(:skip 2))))
+ ;; Test :skipcols parameter.
+ (should
+ (equal "a\nc"
+ (orgtbl-to-generic
+ (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
+ (should
+ (equal "a\nc"
+ (orgtbl-to-generic
+ (org-table-to-lisp
+ "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
+ '(:skipcols (2)))))
+ ;; Test :raw parameter.
+ (when (featurep 'ox-latex)
+ (should
+ (org-string-match-p
+ "/a/"
+ (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
+ '(:backend latex :raw t))))))
+
+(ert-deftest test-org-table/to-latex ()
+ "Test `orgtbl-to-latex' specifications."
+ (should
+ (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
+ (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
+ ;; Test :environment parameter.
+ (should
+ (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
+ (orgtbl-to-latex (org-table-to-lisp "| a |")
+ '(:environment "tabularx"))))
+ ;; Test :booktabs parameter.
+ (should
+ (org-string-match-p
+ "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t)))))
+
+(ert-deftest test-org-table/to-html ()
+ "Test `orgtbl-to-html' specifications."
+ (should
+ (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
+ "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\"
rules=\"groups\" frame=\"hsides\">
+
+
+<colgroup>
+<col class=\"left\" />
+</colgroup>
+<tbody>
+<tr>
+<td class=\"left\">a</td>
+</tr>
+</tbody>
+</table>"))
+ ;; Test :attributes parameter.
+ (should
+ (org-string-match-p
+ "<table>"
+ (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
+ (should
+ (org-string-match-p
+ "<table border=\"2\">"
+ (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border
"2"))))))
+
+(ert-deftest test-org-table/to-texinfo ()
+ "Test `orgtbl-to-texinfo' specifications."
+ (should
+ (equal "@multitable address@hidden address@hidden multitable"
+ (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
+ ;; Test :columns parameter.
+ (should
+ (equal "@multitable @columnfractions .4 address@hidden address@hidden
address@hidden multitable"
+ (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
+ '(:columns ".4 .6"))))
+ (should
+ (equal "@multitable @columnfractions .4 address@hidden address@hidden
address@hidden multitable"
+ (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
+ '(:columns "@columnfractions .4 .6"))))
+ (should
+ (equal "@multitable {xxx} address@hidden address@hidden address@hidden
multitable"
+ (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
+ '(:columns "{xxx} {xx}")))))
+
+(ert-deftest test-org-table/to-orgtbl ()
+ "Test `orgtbl-to-orgtbl' specifications."
+ (should
+ (equal "| a | b |\n|---+---|\n| c | d |"
+ (orgtbl-to-orgtbl
+ (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
+
+(ert-deftest test-org-table/to-unicode ()
+ "Test `orgtbl-to-unicode' specifications."
+ (should
+ (equal "━━━\n a \n━━━"
+ (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
+ ;; Test :narrow parameter.
+ (should
+ (equal "━━━━\n => \n━━━━"
+ (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
+ '(:narrow t)))))
+
+(ert-deftest test-org-table/send-region ()
+ "Test `orgtbl-send-table' specifications."
+ ;; Error when not at a table.
+ (should-error
+ (org-test-with-temp-text "Paragraph"
+ (orgtbl-send-table)))
+ ;; Error when destination is missing.
+ (should-error
+ (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
+ (orgtbl-send-table)))
+ ;; Error when transformation function is not specified.
+ (should-error
+ (org-test-with-temp-text "
+# BEGIN RECEIVE ORGTBL table
+# END RECEIVE ORGTBL table
+#+ORGTBL: SEND table
+<point>| a |"
+ (orgtbl-send-table)))
+ ;; Standard test.
+ (should
+ (equal "| a |\n|---|\n| b |\n"
+ (org-test-with-temp-text "
+# BEGIN RECEIVE ORGTBL table
+# END RECEIVE ORGTBL table
+#+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
+<point>| a |\n|---|\n| b |"
+ (orgtbl-send-table)
+ (goto-char (point-min))
+ (buffer-substring-no-properties
+ (search-forward "# BEGIN RECEIVE ORGTBL table\n")
+ (progn (search-forward "# END RECEIVE ORGTBL table")
+ (match-beginning 0)))))))
+
+
(provide 'test-org-table)
;;; test-org-table.el ends here
--
2.1.0
- [O] [RFC] Rewrite radio tables,
Nicolas Goaziou <=