forked from mirrors/org-mode
org-table: Fix `org-table-get-range' with column formulas
* lisp/org-table.el (org-table-get-stored-formulas): Store complete column formulas including the "$" sign. Remove interactive status. (org-table-get-range): Handle nicely "$n..$m" ranges. Apply changes to `org-table-get-stored-formulas'. Rename some bindings for clarity. (org-table-expand-lhs-ranges): Ignore column formalas. (org-table-remote-reference-indirection): Refactor function. Reported-by: Junpeng Qiu <qjpchmail@gmail.com> <http://permalink.gmane.org/gmane.emacs.orgmode/102861>
This commit is contained in:
parent
53a4209003
commit
c651e150cc
|
@ -1286,8 +1286,9 @@ is always the old value."
|
||||||
(dline (org-table-current-dline))
|
(dline (org-table-current-dline))
|
||||||
(ref (format "@%d$%d" dline col))
|
(ref (format "@%d$%d" dline col))
|
||||||
(ref1 (org-table-convert-refs-to-an ref))
|
(ref1 (org-table-convert-refs-to-an ref))
|
||||||
|
;; Prioritize field formulas over column formulas.
|
||||||
(fequation (or (assoc name eql) (assoc ref eql)))
|
(fequation (or (assoc name eql) (assoc ref eql)))
|
||||||
(cequation (assoc (int-to-string col) eql))
|
(cequation (assoc (format "$%d" col) eql))
|
||||||
(eqn (or fequation cequation)))
|
(eqn (or fequation cequation)))
|
||||||
(let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
|
(let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
|
||||||
(when p (setq eqn p)))
|
(when p (setq eqn p)))
|
||||||
|
@ -2289,31 +2290,31 @@ When NAMED is non-nil, look for a named equation."
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun org-table-get-stored-formulas (&optional noerror)
|
(defun org-table-get-stored-formulas (&optional noerror)
|
||||||
"Return an alist with the stored formulas directly after current table."
|
"Return an alist with the stored formulas directly after current table."
|
||||||
(interactive) ;; FIXME interactive?
|
(save-excursion
|
||||||
(let ((case-fold-search t) scol eq eq-alist strings string seen)
|
(goto-char (org-table-end))
|
||||||
(save-excursion
|
(let ((case-fold-search t))
|
||||||
(goto-char (org-table-end))
|
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
|
||||||
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)")
|
(let ((strings (org-split-string (org-match-string-no-properties 2)
|
||||||
(setq strings (org-split-string (org-match-string-no-properties 2)
|
" *:: *"))
|
||||||
" *:: *"))
|
eq-alist seen)
|
||||||
(while (setq string (pop strings))
|
(dolist (string strings (nreverse eq-alist))
|
||||||
(when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
|
(when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\
|
||||||
(setq scol (if (match-end 2)
|
\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
|
||||||
(match-string 2 string)
|
(let* ((lhs (match-string 1 string))
|
||||||
(match-string 1 string))
|
(rhs (match-string 3 string)))
|
||||||
scol (if (member (string-to-char scol) '(?< ?>))
|
(push (cons lhs rhs) eq-alist)
|
||||||
(concat "$" scol) scol)
|
(cond
|
||||||
eq (match-string 3 string)
|
((not (member lhs seen)) (push lhs seen))
|
||||||
eq-alist (cons (cons scol eq) eq-alist))
|
(noerror
|
||||||
(if (member scol seen)
|
(message
|
||||||
(if noerror
|
"Double definition `%s=' in TBLFM line, please fix by hand"
|
||||||
(progn
|
lhs)
|
||||||
(message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
|
(ding)
|
||||||
(ding)
|
(sit-for 2))
|
||||||
(sit-for 2))
|
(t
|
||||||
(user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
|
(user-error
|
||||||
(push scol seen))))))
|
"Double definition `%s=' in TBLFM line, please fix by hand"
|
||||||
(nreverse eq-alist)))
|
lhs)))))))))))
|
||||||
|
|
||||||
(defun org-table-fix-formulas (key replace &optional limit delta remove)
|
(defun org-table-fix-formulas (key replace &optional limit delta remove)
|
||||||
"Modify the equations after the table structure has been edited.
|
"Modify the equations after the table structure has been edited.
|
||||||
|
@ -2907,7 +2908,9 @@ When CORNERS-ONLY is set, only return the corners of the range as
|
||||||
a list (line1 column1 line2 column2) where line1 and line2 are
|
a list (line1 column1 line2 column2) where line1 and line2 are
|
||||||
line numbers relative to beginning of table, or TBEG, and column1
|
line numbers relative to beginning of table, or TBEG, and column1
|
||||||
and column2 are table column numbers."
|
and column2 are table column numbers."
|
||||||
(let* ((desc (if (eq (string-to-char desc) ?@) desc (concat "@" desc)))
|
(let* ((desc (if (org-string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
|
||||||
|
(replace-regexp-in-string "\\$" "@0$" desc)
|
||||||
|
desc))
|
||||||
(col (or col (org-table-current-column)))
|
(col (or col (org-table-current-column)))
|
||||||
(tbeg (or tbeg (org-table-begin)))
|
(tbeg (or tbeg (org-table-begin)))
|
||||||
(thisline (count-lines tbeg (line-beginning-position))))
|
(thisline (count-lines tbeg (line-beginning-position))))
|
||||||
|
@ -3122,7 +3125,7 @@ known that the table will be realigned a little later anyway."
|
||||||
(log-first-time (current-time))
|
(log-first-time (current-time))
|
||||||
(log-last-time log-first-time)
|
(log-last-time log-first-time)
|
||||||
(cnt 0)
|
(cnt 0)
|
||||||
beg end eqlnum eqlname)
|
beg end eqlcol eqlfield)
|
||||||
;; Insert constants in all formulas
|
;; Insert constants in all formulas
|
||||||
(when eqlist
|
(when eqlist
|
||||||
(org-table-save-field
|
(org-table-save-field
|
||||||
|
@ -3148,15 +3151,16 @@ existing formula for column %s"
|
||||||
(org-table-formula-substitute-names
|
(org-table-formula-substitute-names
|
||||||
(org-table-formula-handle-first/last-rc (cdr x)))))
|
(org-table-formula-handle-first/last-rc (cdr x)))))
|
||||||
eqlist))
|
eqlist))
|
||||||
;; Split the equation list.
|
;; Split the equation list between column formulas and field
|
||||||
|
;; formulas.
|
||||||
(dolist (eq eqlist)
|
(dolist (eq eqlist)
|
||||||
(if (<= (string-to-char (car eq)) ?9)
|
(if (org-string-match-p "\\`\\$[0-9]+\\'" (car eq))
|
||||||
(push eq eqlnum)
|
(push eq eqlcol)
|
||||||
(push eq eqlname)))
|
(push eq eqlfield)))
|
||||||
(setq eqlnum (nreverse eqlnum))
|
(setq eqlcol (nreverse eqlcol))
|
||||||
;; Expand ranges in lhs of formulas
|
;; Expand ranges in lhs of formulas
|
||||||
(setq eqlname (org-table-expand-lhs-ranges (nreverse eqlname)))
|
(setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
|
||||||
;; Get the correct line range to process
|
;; Get the correct line range to process.
|
||||||
(if all
|
(if all
|
||||||
(progn
|
(progn
|
||||||
(setq end (copy-marker (org-table-end)))
|
(setq end (copy-marker (org-table-end)))
|
||||||
|
@ -3172,7 +3176,7 @@ existing formula for column %s"
|
||||||
(re-search-forward org-table-dataline-regexp end t))
|
(re-search-forward org-table-dataline-regexp end t))
|
||||||
(setq beg (match-beginning 0)))
|
(setq beg (match-beginning 0)))
|
||||||
;; Just leave BEG where it is.
|
;; Just leave BEG where it is.
|
||||||
(t nil)))
|
(t (setq beg (line-beginning-position)))))
|
||||||
(setq beg (line-beginning-position)
|
(setq beg (line-beginning-position)
|
||||||
end (copy-marker (line-beginning-position 2))))
|
end (copy-marker (line-beginning-position 2))))
|
||||||
(goto-char beg)
|
(goto-char beg)
|
||||||
|
@ -3182,7 +3186,7 @@ existing formula for column %s"
|
||||||
(let ((current-line (count-lines org-table-current-begin-pos
|
(let ((current-line (count-lines org-table-current-begin-pos
|
||||||
(line-beginning-position)))
|
(line-beginning-position)))
|
||||||
seen-fields)
|
seen-fields)
|
||||||
(dolist (eq eqlname)
|
(dolist (eq eqlfield)
|
||||||
(let* ((name (car eq))
|
(let* ((name (car eq))
|
||||||
(location (assoc name org-table-named-field-locations))
|
(location (assoc name org-table-named-field-locations))
|
||||||
(eq-line (or (nth 1 location)
|
(eq-line (or (nth 1 location)
|
||||||
|
@ -3221,14 +3225,15 @@ existing formula for column %s"
|
||||||
(move-marker org-last-recalc-line (line-beginning-position))
|
(move-marker org-last-recalc-line (line-beginning-position))
|
||||||
(setq org-last-recalc-line
|
(setq org-last-recalc-line
|
||||||
(copy-marker (line-beginning-position))))
|
(copy-marker (line-beginning-position))))
|
||||||
(dolist (entry eqlnum)
|
(dolist (entry eqlcol)
|
||||||
(goto-char org-last-recalc-line)
|
(goto-char org-last-recalc-line)
|
||||||
(org-table-goto-column (string-to-number (car entry)) nil 'force)
|
(org-table-goto-column
|
||||||
|
(string-to-number (substring (car entry) 1)) nil 'force)
|
||||||
(unless (get-text-property (point) :org-untouchable)
|
(unless (get-text-property (point) :org-untouchable)
|
||||||
(org-table-eval-formula
|
(org-table-eval-formula
|
||||||
nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
|
nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
|
||||||
;; Evaluate the field formulas.
|
;; Evaluate the field formulas.
|
||||||
(dolist (eq eqlname)
|
(dolist (eq eqlfield)
|
||||||
(let ((reference (car eq))
|
(let ((reference (car eq))
|
||||||
(formula (cdr eq)))
|
(formula (cdr eq)))
|
||||||
(setq log-last-time
|
(setq log-last-time
|
||||||
|
@ -3353,19 +3358,25 @@ Return nil when the beginning of TBLFM line was not found."
|
||||||
|
|
||||||
(defun org-table-expand-lhs-ranges (equations)
|
(defun org-table-expand-lhs-ranges (equations)
|
||||||
"Expand list of formulas.
|
"Expand list of formulas.
|
||||||
If some of the RHS in the formulas are ranges or a row reference, expand
|
If some of the RHS in the formulas are ranges or a row reference,
|
||||||
them to individual field equations for each field."
|
expand them to individual field equations for each field. This
|
||||||
|
function assumes the table is already analyzed (i.e., using
|
||||||
|
`org-table-analyze')."
|
||||||
(let (res)
|
(let (res)
|
||||||
(dolist (e equations (nreverse res))
|
(dolist (e equations (nreverse res))
|
||||||
(let ((lhs (car e))
|
(let ((lhs (car e))
|
||||||
(rhs (cdr e)))
|
(rhs (cdr e)))
|
||||||
(cond
|
(cond
|
||||||
((string-match "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
|
((org-string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
|
||||||
;; This just refers to one fixed field.
|
;; This just refers to one fixed field.
|
||||||
(push e res))
|
(push e res))
|
||||||
((string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
|
((org-string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
|
||||||
;; This just refers to one fixed named field.
|
;; This just refers to one fixed named field.
|
||||||
(push e res))
|
(push e res))
|
||||||
|
((org-string-match-p "\\`\\$[0-9]+\\'" lhs)
|
||||||
|
;; Column formulas are treated specially and are not
|
||||||
|
;; expanded.
|
||||||
|
(push e res))
|
||||||
((string-match "\\`@[0-9]+\\'" lhs)
|
((string-match "\\`@[0-9]+\\'" lhs)
|
||||||
(dotimes (ic org-table-current-ncol)
|
(dotimes (ic org-table-current-ncol)
|
||||||
(push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
|
(push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
|
||||||
|
@ -5380,29 +5391,22 @@ For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\".
|
||||||
This indirection works only with the format @ROW$COLUMN. The
|
This indirection works only with the format @ROW$COLUMN. The
|
||||||
format \"B3\" is not supported because it can not be
|
format \"B3\" is not supported because it can not be
|
||||||
distinguished from a plain table name or ID."
|
distinguished from a plain table name or ID."
|
||||||
(let ((start 0))
|
(let ((regexp
|
||||||
(while (string-match (concat
|
;; Same as in `org-table-eval-formula'.
|
||||||
;; Same as in `org-table-eval-formula'.
|
(concat "\\<remote([ \t]*\\("
|
||||||
"\\<remote([ \t]*\\("
|
;; Allow "$1", "@<", "$-1", "@<<$1" etc.
|
||||||
;; Allow "$1", "@<", "$-1", "@<<$1" etc.
|
"[@$][^ \t,]+"
|
||||||
"[@$][^ \t,]+"
|
"\\)[ \t]*,[ \t]*\\([^\n)]+\\))")))
|
||||||
;; Same as in `org-table-eval-formula'.
|
(replace-regexp-in-string
|
||||||
"\\)[ \t]*,[ \t]*\\([^\n)]+\\))")
|
regexp
|
||||||
form
|
(lambda (m)
|
||||||
start)
|
(save-match-data
|
||||||
;; The position of the character as far as possible to the right
|
(let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
|
||||||
;; that will not be replaced and particularly not be shifted by
|
(org-table-get-range
|
||||||
;; `replace-match'.
|
(if (org-string-match-p "\\`\\$[0-9]+\\'" eq)
|
||||||
(setq start (match-beginning 1))
|
(concat "@0" eq)
|
||||||
;; Substitute the remote reference with the value found in the
|
eq)))))
|
||||||
;; field.
|
form t t 1)))
|
||||||
(setq form
|
|
||||||
(replace-match
|
|
||||||
(save-match-data
|
|
||||||
(org-table-get-range (org-table-formula-handle-first/last-rc
|
|
||||||
(match-string 1 form))))
|
|
||||||
t t form 1))))
|
|
||||||
form)
|
|
||||||
|
|
||||||
(defmacro org-define-lookup-function (mode)
|
(defmacro org-define-lookup-function (mode)
|
||||||
(let ((mode-str (symbol-name mode))
|
(let ((mode-str (symbol-name mode))
|
||||||
|
|
Loading…
Reference in a new issue