Re: [PATCH] allow for multiline headers

[Mario Frasca <mario@anche.no>]

[-- Attachment #1: Type: text/plain, Size: 2029 bytes --]

Hi Nicolas,

On 13/06/2020 17:18, Nicolas Goaziou wrote:
> Hello,
>
> Mario Frasca <mario@anche.no> writes:
>
>> I can leave existing loops in peace, or edit them keeping them
>> cl-loop-free.  as for myself, I find it practical and readable.
> Then you'll enjoy reading, e.g., `org-contacts-try-completion-prefix'.
> FWIW, I don't.

oops.

I do see your point here.  no, at this level, it's not pleasant any more.

> I don't know Org Plot enough, but these expectations should be located
> in "org-plot.el". I expect `org-table-to-lisp' to be as faithful as
> possible. In particular, this function is used in `org-table-align'; as
> such, it should not do anything fancy.

I have removed the changes, and added some tests that freeze the current 
behaviour.

that was already in the last patch I sent.

> Unit tests are not worth a formal definition. However, "test-ox.el"
> contains unit tests.

I'm not sure what you mean by the first sentence, but I found the header 
tests in the test-ox.el file, and added one where multiple lines header 
is accepted.  is it related enough as to be included in my proposal?

to me, unit tests are readable function definitions, often the best form 
of technical documentation.  I have had colleagues writing tests that 
weren't "unitary" at all, mixing all sort of elements together.  when 
written as an after-thought, it's a serious risk.

> So, if your question is: "should Org support multiple lines headers?",
> I'd say that it already does, but it should definitely be made more
> consistent across the various libraries (e.g., Org Plot).

I can move the org-table-collapse-header function from org-table.el to 
org-plot.el, but to me it makes little sense, relegating a generic 
function to a sub-module: others will look for the functionality in 
org-table, not see it, and duplicate the function somewhere else.

for example, do I understand it correctly, that the concept defined in 
the export functionality, but not in org-table itself?

anyhow, what do we do next?

MF


[-- Attachment #2: 0001-lisp-org-table.el-Allow-collapsing-header-into-singl.patch --]
[-- Type: text/x-patch, Size: 6837 bytes --]

From b407252fc82d29646d267974c626dbc30145f07f Mon Sep 17 00:00:00 2001
From: mfrasca <mario@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 that
collapses multiple header lines into one list.

* 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               |  6 ++--
 lisp/org-table.el              | 27 ++++++++++++++++
 testing/lisp/test-org-table.el | 58 ++++++++++++++++++++++++++++++++++
 testing/lisp/test-ox.el        | 10 ++++++
 4 files changed, 97 insertions(+), 4 deletions(-)

diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index a23195d2a..662d38e54 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -289,11 +289,9 @@ 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 (nth 0 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
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 6462b99c4..c40ad5bea 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -5458,6 +5458,33 @@ 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 glue 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 character."
+  (setq glue (or glue " "))
+  (setq max-header-lines (or max-header-lines 4))
+  (while (equal 'hline (car table))
+    (setq table (cdr table)))
+  (let* ((trailer table)
+	 (header-lines (cl-loop for line in table
+				until (equal line 'hline)
+				collect line
+				do (setq trailer (cdr trailer)))))
+    (if (and trailer (<= (length header-lines) max-header-lines))
+	(cons (apply #'cl-mapcar
+		     #'(lambda (&rest x)
+			 (org-trim
+			  (mapconcat #'identity x glue)))
+		     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
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..e3b078a3c 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 an 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