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:
Nicolas Goaziou 2015-11-12 23:12:18 +01:00
parent 53a4209003
commit c651e150cc

View file

@ -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))