table: 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.

4 files changed, 100 insertions, 7 deletions

diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index bf81d3c..0ff96af 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 3bf3ea8..14ce60d 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -5468,6 +5468,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 #'cl-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
@@ -6149,7 +6174,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 7a4a395..fb9d83f 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -1304,6 +1304,66 @@ See also `test-org-table/copy-field'."
       (should (string= got
 		       expect)))))
 
+
+;;; Tables as Lisp
+
+(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 ()
@@ -1905,7 +1965,7 @@ See also `test-org-table/copy-field'."
       (org-table-sort-lines nil ?n)
       (buffer-string)))))
 
-
+
 ;;; Formulas
 
 (ert-deftest test-org-table/eval-formula ()
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 92ccec0..a5b3bd7 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 "