From: Mario Frasca <mario@anche.no>
To: emacs-orgmode@gnu.org
Subject: Re: [PATCH] allow for multiline headers
Date: Sat, 13 Jun 2020 16:20:58 -0500 [thread overview]
Message-ID: <51f61edb-0cc9-4cb2-cb8f-8e73170633ca@anche.no> (raw)
In-Reply-To: <f2f9160b-399c-71e3-357d-f1454e975b59@anche.no>
[-- Attachment #1: Type: text/plain, Size: 73 bytes --]
what about these two groups of tests, and the header collapse function?
[-- Attachment #2: 0001-lisp-org-table.el-Allow-collapsing-header-into-singl.patch --]
[-- Type: text/x-patch, Size: 6052 bytes --]
From ceb21024159a75dbdb9fef32eebe1fc8c7076d2f 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.
---
lisp/org-plot.el | 6 ++--
lisp/org-table.el | 27 ++++++++++++++++
testing/lisp/test-org-table.el | 58 ++++++++++++++++++++++++++++++++++
3 files changed, 87 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 ()
--
2.20.1
next prev parent reply other threads:[~2020-06-13 21:22 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-06-12 17:14 [PATCH] allow for multiline headers Mario Frasca
2020-06-12 22:44 ` Nicolas Goaziou
2020-06-13 20:20 ` Mario Frasca
2020-06-13 21:20 ` Mario Frasca [this message]
2020-06-13 22:18 ` Nicolas Goaziou
2020-06-13 23:03 ` Mario Frasca
2020-06-14 19:23 ` Nicolas Goaziou
[not found] ` <3e6ee551-4ef7-7d96-93dc-19a4973e1af8@anche.no>
[not found] ` <871rm5vslh.fsf@nicolasgoaziou.fr>
2020-06-27 15:39 ` Mario Frasca
2020-06-28 23:17 ` Nicolas Goaziou
2020-06-29 0:27 ` Mario Frasca
2020-06-29 12:50 ` Nicolas Goaziou
2020-06-29 16:26 ` Mario Frasca
2020-06-29 18:36 ` Nicolas Goaziou
2020-06-29 22:01 ` Mario Frasca
2020-07-01 10:46 ` Nicolas Goaziou
2020-07-01 12:06 ` Mario Frasca
2020-07-04 8:58 ` Nicolas Goaziou
2020-07-04 13:47 ` Mario Frasca
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=51f61edb-0cc9-4cb2-cb8f-8e73170633ca@anche.no \
--to=mario@anche.no \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).