Browse Source

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>
Nicolas Goaziou 9 years ago
parent
commit
c651e150cc
1 changed files with 71 additions and 67 deletions
  1. 71 67
      lisp/org-table.el

+ 71 - 67
lisp/org-table.el

@@ -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?
-  (let ((case-fold-search t) scol eq eq-alist strings string seen)
-    (save-excursion
-      (goto-char (org-table-end))
-      (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)")
-	(setq strings (org-split-string (org-match-string-no-properties 2)
-					" *:: *"))
-	(while (setq string (pop strings))
-	  (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
-	    (setq scol (if (match-end 2)
-			   (match-string 2 string)
-			 (match-string 1 string))
-		  scol (if (member (string-to-char scol) '(?< ?>))
-			   (concat "$" scol) scol)
-		  eq (match-string 3 string)
-		  eq-alist (cons (cons scol eq) eq-alist))
-	    (if (member scol seen)
-		(if noerror
-		    (progn
-		      (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
-		      (ding)
-		      (sit-for 2))
-		  (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
-	      (push scol seen))))))
-    (nreverse eq-alist)))
+  (save-excursion
+    (goto-char (org-table-end))
+    (let ((case-fold-search t))
+      (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
+	(let ((strings (org-split-string (org-match-string-no-properties 2)
+					 " *:: *"))
+	      eq-alist seen)
+	  (dolist (string strings (nreverse eq-alist))
+	    (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\
+\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
+	      (let* ((lhs (match-string 1 string))
+		     (rhs (match-string 3 string)))
+		(push (cons lhs rhs) eq-alist)
+		(cond
+		 ((not (member lhs seen)) (push lhs seen))
+		 (noerror
+		  (message
+		   "Double definition `%s=' in TBLFM line, please fix by hand"
+		   lhs)
+		  (ding)
+		  (sit-for 2))
+		 (t
+		  (user-error
+		   "Double definition `%s=' in TBLFM line, please fix by hand"
+		   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)
-	       (push eq eqlnum)
-	     (push eq eqlname)))
-	 (setq eqlnum (nreverse eqlnum))
+	   (if (org-string-match-p "\\`\\$[0-9]+\\'" (car eq))
+	       (push eq eqlcol)
+	     (push eq eqlfield)))
+	 (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)))
-	 ;; Get the correct line range to process
+	 (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
+	 ;; 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
-them to individual field equations for each field."
+If some of the RHS in the formulas are ranges or a row reference,
+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))
-    (while (string-match (concat
-			  ;; Same as in `org-table-eval-formula'.
-			  "\\<remote([ \t]*\\("
-			  ;; Allow "$1", "@<", "$-1", "@<<$1" etc.
-			  "[@$][^ \t,]+"
-			  ;; Same as in `org-table-eval-formula'.
-			  "\\)[ \t]*,[ \t]*\\([^\n)]+\\))")
-			 form
-			 start)
-      ;; The position of the character as far as possible to the right
-      ;; that will not be replaced and particularly not be shifted by
-      ;; `replace-match'.
-      (setq start (match-beginning 1))
-      ;; Substitute the remote reference with the value found in the
-      ;; field.
-      (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)
+  (let ((regexp
+	 ;; Same as in `org-table-eval-formula'.
+	 (concat "\\<remote([ \t]*\\("
+		 ;; Allow "$1", "@<", "$-1", "@<<$1" etc.
+		 "[@$][^ \t,]+"
+		 "\\)[ \t]*,[ \t]*\\([^\n)]+\\))")))
+    (replace-regexp-in-string
+     regexp
+     (lambda (m)
+       (save-match-data
+	 (let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
+	   (org-table-get-range
+	    (if (org-string-match-p "\\`\\$[0-9]+\\'" eq)
+		(concat "@0" eq)
+	      eq)))))
+     form t t 1)))
 
 
 (defmacro org-define-lookup-function (mode)
 (defmacro org-define-lookup-function (mode)
   (let ((mode-str (symbol-name mode))
   (let ((mode-str (symbol-name mode))