forked from mirrors/org-mode
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.
This commit is contained in:
Nicolas Goaziou
parent
7e4847a554
commit
9ddfe45314
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue