summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2019-06-27 23:57:13 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2019-06-28 00:07:25 +0200
commit9ddfe453149d1f1970310f6ca24a2e17bb6c20c4 (patch)
treea58bbcf6459c46f0896c9fddcb472ae4ada05f97
parent7e4847a55406c8050a971f901e657bbef5dc7d73 (diff)
downloadorg-mode-9ddfe453149d1f1970310f6ca24a2e17bb6c20c4.tar.gz
org-table: Improve `org-table-copy-down'
* lisp/org-table.el (org-table--increment-field): New function. (org-table-copy-down): Use new function. * testing/lisp/test-org-table.el (test-org-table/copy-down): New test. * doc/org-manual.org (Calculations): Update documentation.
-rw-r--r--doc/org-manual.org15
-rw-r--r--etc/ORG-NEWS6
-rw-r--r--lisp/org-table.el218
-rw-r--r--testing/lisp/test-org-table.el122
4 files changed, 283 insertions, 78 deletions
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 440888b..8318e7c 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -1574,12 +1574,15 @@ you, configure the option ~org-table-auto-blank-field~.
#+vindex: org-table-copy-increment
When current field is empty, copy from first non-empty field above.
When not empty, copy current field down to next row and move point
- along with it. Depending on the variable
- ~org-table-copy-increment~, integer field values can be incremented
- during copy. Integers that are too large are not incremented,
- however. Also, a ~0~ prefix argument temporarily disables the
- increment. This key is also used by shift-selection and related
- modes (see [[*Packages that conflict with Org mode]]).
+ along with it.
+
+ Depending on the variable ~org-table-copy-increment~, integer and
+ time stamp field values, and fields prefixed or suffixed with
+ a whole number, can be incremented during copy. Also, a ~0~ prefix
+ argument temporarily disables the increment.
+
+ This key is also used by shift-selection and related modes (see
+ [[*Packages that conflict with Org mode]]).
*** Miscellaneous
:PROPERTIES:
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index bd27fae..0a0ba43 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -255,6 +255,12 @@ Function ~org-latex-preview~, formerly known as
~org-toggle-latex-fragment~, has a hopefully simpler and more
predictable behavior. See its docstring for details.
+*** ~org-table-copy-down~ supports patterns
+
+When ~org-table-copy-increment~ is non-nil, it is now possible to
+increment fields like =A1=, or =0A=, i.e., any string prefixed or
+suffixed with a whole number.
+
*** No more special indentation for description items
Descriptions items are indented like regular ones, i.e., text starts
diff --git a/lisp/org-table.el b/lisp/org-table.el
index a5d617c..129be23 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1680,6 +1680,103 @@ If there is no active region, use just the field at point."
(if (org-region-active-p) (region-end) (point))))
(org-table-copy-region beg end 'cut))
+(defun org-table--increment-field (field previous)
+ "Increment string FIELD according to PREVIOUS field.
+
+Increment FIELD only if it is a string representing a number, per
+Emacs Lisp syntax, a timestamp, or is either prefixed or suffixed
+with a number. In any other case, return FIELD as-is.
+
+If PREVIOUS has the same structure as FIELD, e.g.,
+a number-prefixed string with the same pattern, the increment
+step is the difference between numbers (or timestamps, measured
+in days) in PREVIOUS and FIELD. Otherwise, it uses
+`org-table-copy-increment', if the variable contains a number, or
+default to 1.
+
+The function assumes `org-table-copy-increment' is non-nil."
+ (let* ((default-step (if (numberp org-table-copy-increment)
+ org-table-copy-increment
+ 1))
+ (number-regexp ;Lisp read syntax for numbers
+ (rx (and string-start
+ (opt (any "+-"))
+ (or (and (one-or-more digit) (opt "."))
+ (and (zero-or-more digit) "." (one-or-more digit)))
+ (opt (any "eE") (opt (opt (any "+-")) (one-or-more digit)))
+ string-end)))
+ (number-prefix-regexp (rx (and string-start (one-or-more digit))))
+ (number-suffix-regexp (rx (and (one-or-more digit) string-end)))
+ (analyze
+ (lambda (field)
+ ;; Analyse string FIELD and return information related to
+ ;; increment or nil. When non-nil, return value has the
+ ;; following scheme: (TYPE VALUE PATTERN) where
+ ;; - TYPE is a symbol among `number', `prefix', `suffix'
+ ;; and `timestamp',
+ ;; - VALUE is a timestamp if TYPE is `timestamp', or
+ ;; a number otherwise,
+ ;; - PATTERN is the field without its prefix, or suffix if
+ ;; TYPE is either `prefix' or `suffix' , or nil
+ ;; otherwise.
+ (cond ((not (org-string-nw-p field)) nil)
+ ((string-match-p number-regexp field)
+ (list 'number
+ (string-to-number field)
+ nil))
+ ((string-match number-prefix-regexp field)
+ (list 'prefix
+ (string-to-number (match-string 0 field))
+ (substring field (match-end 0))))
+ ((string-match number-suffix-regexp field)
+ (list 'suffix
+ (string-to-number (match-string 0 field))
+ (substring field 0 (match-beginning 0))))
+ ((string-match-p org-ts-regexp3 field)
+ (list 'timestamp field nil))
+ (t nil))))
+ (next-number-string
+ (lambda (n1 &optional n2)
+ ;; Increment number N1 and return it as a string. If N2
+ ;; is also a number, deduce increment step from the
+ ;; difference between N1 and N2. Otherwise, increment
+ ;; step is `default-step'.
+ (number-to-string (if n2 (+ n1 (- n1 n2)) (+ n1 default-step)))))
+ (shift-timestamp
+ (lambda (t1 &optional t2)
+ ;; Increment timestamp T1 and return it. If T2 is also
+ ;; a timestamp, deduce increment step from the difference,
+ ;; in days, between T1 and T2. Otherwise, increment by
+ ;; `default-step' days.
+ (with-temp-buffer
+ (insert t1)
+ (org-timestamp-up-day (if (not t2) default-step
+ (- (org-time-string-to-absolute t1)
+ (org-time-string-to-absolute t2))))
+ (buffer-string)))))
+ ;; Check if both PREVIOUS and FIELD have the same type. Also, if
+ ;; the case of prefixed or suffixed numbers, make sure their
+ ;; pattern, i.e., the part of the string without the prefix or the
+ ;; suffix, is the same.
+ (pcase (cons (funcall analyze field) (funcall analyze previous))
+ (`((number ,n1 ,_) . (number ,n2 ,_))
+ (funcall next-number-string n1 n2))
+ (`((number ,n ,_) . ,_)
+ (funcall next-number-string n))
+ (`((prefix ,n1 ,p1) . (prefix ,n2 ,p2))
+ (concat (funcall next-number-string n1 (and (equal p1 p2) n2)) p1))
+ (`((prefix ,n ,p) . ,_)
+ (concat (funcall next-number-string n) p))
+ (`((suffix ,n1 ,p1) . (suffix ,n2 ,p2))
+ (concat p1 (funcall next-number-string n1 (and (equal p1 p2) n2))))
+ (`((suffix ,n ,p) . ,_)
+ (concat p (funcall next-number-string n)))
+ (`((timestamp ,t1 ,_) . (timestamp ,t2 ,_))
+ (funcall shift-timestamp t1 t2))
+ (`((timestamp ,t1 ,_) . ,_)
+ (funcall shift-timestamp t1))
+ (_ field))))
+
;;;###autoload
(defun org-table-copy-down (n)
"Copy the value of the current field one row below.
@@ -1693,79 +1790,60 @@ row, and the cursor is moved with it. Therefore, repeating this
command causes the column to be filled row-by-row.
If the variable `org-table-copy-increment' is non-nil and the
-field is an integer or a timestamp, it will be incremented while
-copying. By default, increment by the difference between the
-value in the current field and the one in the field above. To
-increment using a fixed integer, set `org-table-copy-increment'
-to a number. In the case of a timestamp, increment by days."
+field is a number, a timestamp, or is either prefixed or suffixed
+with a number, it will be incremented while copying. By default,
+increment by the difference between the value in the current
+field and the one in the field above, if any. To increment using
+a fixed integer, set `org-table-copy-increment' to a number. In
+the case of a timestamp, increment by days.
+
+However, when N is 0, do not increment the field at all."
(interactive "p")
- (let* ((colpos (org-table-current-column))
- (col (current-column))
- (field (save-excursion (org-table-get-field)))
- (field-up (or (save-excursion
- (org-table-get (1- (org-table-current-line))
- (org-table-current-column))) ""))
- (non-empty (string-match "[^ \t]" field))
- (non-empty-up (string-match "[^ \t]" field-up))
- (beg (org-table-begin))
- (orig-n n)
- txt txt-up inc)
- (org-table-check-inside-data-field)
- (if (not non-empty)
- (save-excursion
- (setq txt
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))
- (setq field-up
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))
- (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
- ;; Above field was not empty, go down to the next row. Skip
- ;; alignment since we do it at the end of the process anyway.
- (setq txt (org-trim field))
+ (org-table-check-inside-data-field)
+ (let* ((beg (org-table-begin))
+ (column (org-table-current-column))
+ (initial-field (save-excursion
+ (let ((f (org-string-nw-p (org-table-get-field))))
+ (and f (org-trim f)))))
+ field field-above next-field)
+ (save-excursion
+ ;; Get reference field.
+ (if initial-field (setq field initial-field)
+ (beginning-of-line)
+ (setq field
+ (catch :exit
+ (while (re-search-backward org-table-dataline-regexp beg t)
+ (let ((f (org-string-nw-p (org-table-get-field column))))
+ (cond ((and (> n 1) f) (cl-decf n))
+ (f (throw :exit (org-trim f)))
+ (t nil))
+ (beginning-of-line)))
+ (user-error "No non-empty field found"))))
+ ;; Check if increment is appropriate, and how it should be done.
+ (when (and org-table-copy-increment (/= n 0))
+ ;; If increment step is not explicit, get non-empty field just
+ ;; above the field being incremented to guess it.
+ (unless (numberp org-table-copy-increment)
+ (setq field-above
+ (let ((f (unless (= beg (line-beginning-position))
+ (forward-line -1)
+ (not (org-at-table-hline-p))
+ (org-table-get-field column))))
+ (and (org-string-nw-p f)
+ (org-trim f)))))
+ ;; Compute next field.
+ (setq next-field (org-table--increment-field field field-above))))
+ ;; Since initial field in not empty, we modify row below instead.
+ ;; Skip alignment since we do it at the end of the process anyway.
+ (when initial-field
(let ((org-table-may-need-update nil)) (org-table-next-row))
(org-table-blank-field))
- (if non-empty-up (setq txt-up (org-trim field-up)))
- (setq inc (cond
- ((numberp org-table-copy-increment) org-table-copy-increment)
- (txt-up (cond ((and (string-match org-ts-regexp3 txt-up)
- (string-match org-ts-regexp3 txt))
- (- (org-time-string-to-absolute txt)
- (org-time-string-to-absolute txt-up)))
- ((string-match org-ts-regexp3 txt) 1)
- ((string-match "\\([-+]\\)?[0-9]*\\(?:\\.[0-9]+\\)?" txt-up)
- (- (string-to-number txt)
- (string-to-number (match-string 0 txt-up))))
- (t 1)))
- (t 1)))
- (if (not txt)
- (user-error "No non-empty field found")
- (if (and org-table-copy-increment
- (not (equal orig-n 0))
- (string-match-p "^[-+^/*0-9eE.]+$" txt)
- (< (string-to-number txt) 100000000))
- (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
- (insert txt)
- (org-move-to-column col)
- (if (and org-table-copy-increment (org-at-timestamp-p 'lax))
- (org-timestamp-up-day inc)
- (org-table-maybe-recalculate-line))
- (org-table-align)
- (org-move-to-column col))))
+ ;; Insert the new field. NEW-FIELD may be nil if
+ ;; `org-table-increment' is nil, or N = 0. In that case, copy
+ ;; FIELD.
+ (insert (or next-field field))
+ (org-table-maybe-recalculate-line)
+ (org-table-align)))
;;;###autoload
(defun org-table-copy-region (beg end &optional cut)
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 8f83c5d..d6ef392 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -572,8 +572,7 @@ reference (with row). Mode string N."
"$8 = '(let ((l '(@0$1..@0$4))) "
"(if l (/ (apply '+ l) (length l)) \"\")); N :: "
"$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
- "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")
-))
+ "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")))
(ert-deftest test-org-table/copy-field ()
"Experiments on how to copy one field into another field.
@@ -626,6 +625,125 @@ See also `test-org-table/remote-reference-access'."
"
1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
+(ert-deftest test-org-table/copy-down ()
+ "Test `org-table-copy-down' specifications."
+ ;; Error when there is nothing to copy in the current field or the
+ ;; field above.
+ (should-error
+ (org-test-with-temp-text "| |\n| <point> |"
+ (org-table-copy-down 1)))
+ ;; Error when there is nothing to copy in the Nth field.
+ (should-error
+ (org-test-with-temp-text "| |\n| foo |\n| <point> |"
+ (org-table-copy-down 2)))
+ ;; In an empty field, copy field above.
+ (should
+ (equal "| foo |\n| foo |"
+ (org-test-with-temp-text "| foo |\n| <point> |"
+ (org-table-copy-down 1)
+ (buffer-string))))
+ ;; In a non-empty field, copy it below.
+ (should
+ (equal "| foo |\n| foo |"
+ (org-test-with-temp-text "| <point>foo |"
+ (org-table-copy-down 1)
+ (buffer-string))))
+ ;; If field is a number or a timestamp, or is prefixed or suffixed
+ ;; with a number, increment it by one unit.
+ (should
+ (equal "| 1 |\n| 2 |\n"
+ (org-test-with-temp-text "| <point>1 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (string-match-p "<2012-03-30"
+ (org-test-with-temp-text "| <point><2012-03-29> |"
+ (let ((org-table-copy-increment t))
+ (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| A1 |\n| A2 |\n"
+ (org-test-with-temp-text "| <point>A1 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| 1A |\n| 2A |\n"
+ (org-test-with-temp-text "| <point>1A |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ ;; When `org-table-copy-increment' is nil, or when argument is 0, do
+ ;; not increment.
+ (should
+ (equal "| 1 |\n| 1 |\n"
+ (org-test-with-temp-text "| <point>1 |"
+ (let ((org-table-copy-increment nil)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| 1 |\n| 1 |\n"
+ (org-test-with-temp-text "| <point>1 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 0))
+ (buffer-string))))
+ ;; When there is a field just above field being incremented, try to
+ ;; use it to guess increment step.
+ (should
+ (equal "| 4 |\n| 3 |\n| 2 |\n"
+ (org-test-with-temp-text "| 4 |\n| <point>3 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| A0 |\n| A2 |\n| A4 |\n"
+ (org-test-with-temp-text "| A0 |\n| <point>A2 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ ;; Both fields need to have the same type. In the special case of
+ ;; number-prefixed or suffixed fields, make sure both fields have
+ ;; the same pattern.
+ (should
+ (equal "| A4 |\n| 3 |\n| 4 |\n"
+ (org-test-with-temp-text "| A4 |\n| <point>3 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| 0A |\n| A2 |\n| A3 |\n"
+ (org-test-with-temp-text "| 0A |\n| <point>A2 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| A0 |\n| 2A |\n| 3A |\n"
+ (org-test-with-temp-text "| A0 |\n| <point>2A |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ ;; Do not search field above past blank fields and horizontal
+ ;; separators.
+ (should
+ (equal "| 4 |\n|---|\n| 3 |\n| 4 |\n"
+ (org-test-with-temp-text "| 4 |\n|---|\n| <point>3 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ (should
+ (equal "| 4 |\n| |\n| 3 |\n| 4 |\n"
+ (org-test-with-temp-text "| 4 |\n| |\n| <point>3 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 1))
+ (buffer-string))))
+ ;; When `org-table-copy-increment' is a number, use it as the
+ ;; increment step, ignoring any previous field.
+ (should
+ (equal "| 1 |\n| 3 |\n| 6 |\n"
+ (org-test-with-temp-text "| 1 |\n| <point>3 |"
+ (let ((org-table-copy-increment 3)) (org-table-copy-down 1))
+ (buffer-string))))
+ ;; However, if argument is 0, do not increment whatsoever.
+ (should
+ (equal "| 1 |\n| 3 |\n| 3 |\n"
+ (org-test-with-temp-text "| 1 |\n| <point>3 |"
+ (let ((org-table-copy-increment t)) (org-table-copy-down 0))
+ (buffer-string))))
+ (should
+ (equal "| 1 |\n| 3 |\n| 3 |\n"
+ (org-test-with-temp-text "| 1 |\n| <point>3 |"
+ (let ((org-table-copy-increment 3)) (org-table-copy-down 0))
+ (buffer-string)))))
+
(ert-deftest test-org-table/sub-total ()
"Grouped rows with sub-total.
Begin range with \"@II\" to handle multiline header. Convert