Hi Nicolas and the whole world,
On 24/06/2020 02:19, Nicolas Goaziou wrote:
This could be extracted as an independent function, which would return
the header, or nil. We can also imagine a function returning a cons cell
(HEADER . BODY), both HEADER and BODY being list of rows (possibly
empty).
I was thinking of this myself too. but, after all, the goal of this
function is not only to find the header, but to collapse it into
a single line.
I suggested this because you were saying earlier in this thread IIRC
that Org has no tooling to handle table headers.
I would like to discuss this in a chat, who's available to join
#org-mode on freenode?
if it was splitting the header from the body, then yes, it would
definitely make sense, the cons cell you suggest.
It _is_ splitting the header from the body. Barring initial `hline'
symbols, header-lines and trailer variables are exactly HEADER and BODY
above.
same as above, I wish to hear opinions, collect them, and that we take a
decision with shorter communication lines.
+ (table (org-table-collapse-header (org-table-to-lisp)))
+ (num-cols (length (car table))))
Note that there is no guarantee that all rows have the same length.
E.g.,
| a |
| b | c |
many other points in the code assume rows have the same length. I
haven't checked if the assumption is correct, I just used it as I saw
the code already does.
I think I have processed most other remarks in the new patch.
and I have signed and received confirmation of reception of my FSF
paperwork :-)
ciao,
Mario
>From ca92fb1e4ee66ed39e5b567880faccc513d263d4 Mon Sep 17 00:00:00 2001
From: mfrasca <ma...@anche.no>
Date: Fri, 12 Jun 2020 11:42:34 -0500
Subject: [PATCH] lisp/org-table.el: Allow collapsing header into single line
* lisp/org-table.el (org-table-collapse-header): New function.
* lisp/org-plot.el (org-plot/gnuplot): Use org-table-collapse-header
and trust there will be no more leading `hline' symbols in lisp table.
* testing/lisp/test-org-table.el (test-org-table/to-lisp):
Adding tests to already existing to-lisp function.
(test-org-table/collapse-header): Adding tests to new
collapse-header function.
* testing/lisp/test-ox.el (test-org-export/has-header-p): Testing
exporting table with multi-line header.
---
lisp/org-plot.el | 8 ++---
lisp/org-table.el | 27 +++++++++++++++-
testing/lisp/test-org-table.el | 58 ++++++++++++++++++++++++++++++++++
testing/lisp/test-ox.el | 10 ++++++
4 files changed, 97 insertions(+), 6 deletions(-)
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index a23195d2a..35077cfc3 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -289,14 +289,12 @@ line directly before or after the table."
(setf params (plist-put params (car pair) (cdr pair)))))
;; collect table and table information
(let* ((data-file (make-temp-file "org-plot"))
- (table (org-table-to-lisp))
- (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
- (nth 0 table)))))
+ (table (org-table-collapse-header (org-table-to-lisp)))
+ (num-cols (length (car table))))
(run-with-idle-timer 0.1 nil #'delete-file data-file)
- (while (eq 'hline (car table)) (setf table (cdr table)))
(when (eq (cadr table) 'hline)
(setf params
- (plist-put params :labels (nth 0 table))) ; headers to labels
+ (plist-put params :labels (car table))) ; headers to labels
(setf table (delq 'hline (cdr table)))) ; clean non-data from table
;; Collect options.
(save-excursion (while (and (equal 0 (forward-line -1))
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 6462b99c4..248b1ed50 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -5458,6 +5458,31 @@ The table is taken from the parameter TXT, or from the buffer at point."
(forward-line))
(nreverse table)))))
+(defun org-table-collapse-header (table &optional separator max-header-lines)
+ "Collapse the lines before 'hline into a single header.
+
+The given TABLE is a list of lists as returned by `org-table-to-lisp'.
+The leading lines before the first `hline' symbol are considered
+forming the table header. This function collapses all leading header
+lines into a single header line, followed by the `hline' symbol, and
+the rest of the TABLE. Header cells are glued together with a space,
+or the given SEPARATOR."
+ (while (eq (car table) 'hline) (pop table))
+ (let* ((separator (or separator " "))
+ (max-header-lines (or max-header-lines 4))
+ (trailer table)
+ (header-lines (cl-loop for line in table
+ until (eq 'hline line)
+ collect (pop trailer))))
+ (if (and trailer (<= (length header-lines) max-header-lines))
+ (cons (apply #'mapcar
+ (lambda (&rest x)
+ (org-trim
+ (mapconcat #'identity x separator)))
+ header-lines)
+ trailer)
+ table)))
+
(defun orgtbl-send-table (&optional maybe)
"Send a transformed version of table at point to the receiver position.
With argument MAYBE, fail quietly if no transformation is defined
@@ -6139,7 +6164,7 @@ which will prompt for the width."
((numberp ask) ask)
(t 12))))
;; Skip any hline a the top of table.
- (while (eq (car table) 'hline) (setq table (cdr table)))
+ (while (eq (car table) 'hline) (pop table))
;; Skip table header if any.
(dolist (x (or (cdr (memq 'hline table)) table))
(when (consp x)
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 64a1b4b16..5d54f4999 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -1304,6 +1304,64 @@ See also `test-org-table/copy-field'."
(should (string= got
expect)))))
+;;; the initial to lisp converter
+
+(ert-deftest test-org-table/to-lisp ()
+ "Test `orgtbl-to-lisp' specifications."
+ ;; 2x2 no header
+ (should
+ (equal '(("a" "b") ("c" "d"))
+ (org-table-to-lisp "|a|b|\n|c|d|")))
+ ;; 2x2 with 1-line header
+ (should
+ (equal '(("a" "b") hline ("c" "d"))
+ (org-table-to-lisp "|a|b|\n|-\n|c|d|")))
+ ;; 2x4 with 2-line header
+ (should
+ (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
+ (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))
+ ;; leading hlines do not get stripped
+ (should
+ (equal '(hline ("a" "b") hline ("c" "d"))
+ (org-table-to-lisp "|-\n|a|b|\n|-\n|c|d|")))
+ (should
+ (equal '(hline ("a" "b") ("c" "d"))
+ (org-table-to-lisp "|-\n|a|b|\n|c|d|")))
+ (should
+ (equal '(hline hline hline hline ("a" "b") ("c" "d"))
+ (org-table-to-lisp "|-\n|-\n|-\n|-\n|a|b|\n|c|d|"))))
+
+(ert-deftest test-org-table/collapse-header ()
+ "Test `orgtbl-to-lisp' specifications."
+ ;; 2x2 no header - no collapsing
+ (should
+ (equal '(("a" "b") ("c" "d"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|c|d|"))))
+ ;; 2x2 with 1-line header - no collapsing
+ (should
+ (equal '(("a" "b") hline ("c" "d"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|-\n|c|d|"))))
+ ;; 2x4 with 2-line header - collapsed
+ (should
+ (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|"))))
+ ;; 2x4 with 2-line header, custom glue - collapsed
+ (should
+ (equal '(("a.A" "b.B") hline ("c" "d") ("aa" "bb"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") ".")))
+ ;; 2x4 with 2-line header, threshold 1 - not collapsed
+ (should
+ (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 1)))
+ ;; 2x4 with 2-line header, threshold 2 - collapsed
+ (should
+ (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 2)))
+ ;; 2x8 with 6-line header, default threshold 5 - not collapsed
+ (should
+ (equal '(("a" "b") ("A" "B") ("a" "b") ("A" "B") ("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
+ (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|a|b|\n|A|B|\n|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))))
+
;;; Radio Tables
(ert-deftest test-org-table/to-generic ()
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 92ccec08e..a5b3bd770 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -4129,6 +4129,16 @@ Another text. (ref:text)
(org-export-table-has-header-p
(org-element-map tree 'table 'identity info 'first-match)
info)))
+ ;; With a multi-line header.
+ (should
+ (org-test-with-parsed-data "
+| a | b |
+| 0 | 1 |
+|---+---|
+| a | w |"
+ (org-export-table-has-header-p
+ (org-element-map tree 'table 'identity info 'first-match)
+ info)))
;; Without an header.
(should-not
(org-test-with-parsed-data "
--
2.20.1