mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-26 07:33:39 +00:00
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.
This commit is contained in:
parent
0c1740c919
commit
73e367fca4
@ -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))
|
||||
|
@ -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)
|
||||
|
@ -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 ()
|
||||
|
@ -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 "
|
||||
|
Loading…
Reference in New Issue
Block a user