ソースを参照

org-table: Fix "$<" constructs in formulas

* lisp/org-table.el (org-table-recalculate): Expand "$<" without
  returning an error.  Small refactoring.

* testing/lisp/test-org-table.el (test-org-table/first-rc): New test.

Reported-by: Stefan Nobis <stefan-ml@snobis.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/103693>
Nicolas Goaziou 9 年 前
コミット
713fe873b7
2 ファイル変更36 行追加29 行削除
  1. 24 29
      lisp/org-table.el
  2. 12 0
      testing/lisp/test-org-table.el

+ 24 - 29
lisp/org-table.el

@@ -3129,44 +3129,39 @@ known that the table will be realigned a little later anyway."
     (org-table-analyze)
     (let* ((eqlist (sort (org-table-get-stored-formulas)
 			 (lambda (a b) (string< (car a) (car b)))))
-	   (eqlist1 (copy-sequence eqlist))
 	   (inhibit-redisplay (not debug-on-error))
 	   (line-re org-table-dataline-regexp)
 	   (log-first-time (current-time))
 	   (log-last-time log-first-time)
 	   (cnt 0)
 	   beg end eqlcol eqlfield)
-      ;; Insert constants in all formulas
+      ;; Insert constants in all formulas.
       (when eqlist
 	(org-table-save-field
-	 (setq eqlist
-	       (mapcar
-		(lambda (x)
-		  (when (string-match "\\`@-?I+" (car x))
-		    (user-error "Can't assign to hline relative reference"))
-		  (when (string-match "\\`$[<>]" (car x))
-		    (let ((old-lhs (car x)))
-		      (setq x
-			    (cons
-			     (substring
-			      (org-table-formula-handle-first/last-rc old-lhs)
-			      1)
-			     (cdr x)))
-		      (when (assoc (car x) eqlist1)
-			(user-error "\"%s=\" formula tries to overwrite \
-existing formula for column %s"
-				    old-lhs
-				    (car x)))))
-		  (cons (org-table-formula-handle-first/last-rc (car x))
-			(org-table-formula-substitute-names
-			 (org-table-formula-handle-first/last-rc (cdr x)))))
-		eqlist))
-	 ;; Split the equation list between column formulas and field
-	 ;; formulas.
+	 ;; Expand equations, then split the equation list between
+	 ;; column formulas and field formulas.
 	 (dolist (eq eqlist)
-	   (if (org-string-match-p "\\`\\$[0-9]+\\'" (car eq))
-	       (push eq eqlcol)
-	     (push eq eqlfield)))
+	   (let* ((rhs (org-table-formula-substitute-names
+			(org-table-formula-handle-first/last-rc (cdr eq))))
+		  (old-lhs (car eq))
+		  (lhs
+		   (org-table-formula-handle-first/last-rc
+		    (cond
+		     ((string-match "\\`@-?I+" old-lhs)
+		      (user-error "Can't assign to hline relative reference"))
+		     ((string-match "\\`$[<>]" old-lhs)
+		      (let ((new (org-table-formula-handle-first/last-rc
+				  old-lhs)))
+			(when (assoc new eqlist)
+			  (user-error "\"%s=\" formula tries to overwrite \
+existing formula for column %s"
+				      old-lhs
+				      new))
+			new))
+		     (t old-lhs)))))
+	     (if (org-string-match-p "\\`\\$[0-9]+\\'" lhs)
+		 (push (cons lhs rhs) eqlcol)
+	       (push (cons lhs rhs) eqlfield))))
 	 (setq eqlcol (nreverse eqlcol))
 	 ;; Expand ranges in lhs of formulas
 	 (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))

+ 12 - 0
testing/lisp/test-org-table.el

@@ -1835,6 +1835,18 @@ is t, then new columns should be added as needed"
       (org-table-calc-current-TBLFM)
       (buffer-string)))))
 
+(ert-deftest test-org-table/first-rc ()
+  "Test \"$<\" constructs in formulas."
+  (should
+   (org-string-match-p
+    "| 1 | 2 |"
+    (org-test-with-temp-text
+	"|   | 2 |
+<point>#+TBLFM: $<=1"
+      (org-table-calc-current-TBLFM)
+      (buffer-string)))))
+
+
 (provide 'test-org-table)
 
 ;;; test-org-table.el ends here