Merge branch 'maint'

2 files changed, 141 insertions, 133 deletions

diff --git a/lisp/org-table.el b/lisp/org-table.el
index fe6e0ed..22508b7 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -2778,139 +2778,140 @@ known that the table will be realigned a little later anyway."
 	   beg end eqlcol eqlfield)
       ;; Insert constants in all formulas.
       (when eqlist
-	(org-table-save-field
-	 ;; Expand equations, then split the equation list between
-	 ;; column formulas and field formulas.
-	 (dolist (eq eqlist)
-	   (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 \
+	(org-table-with-shrunk-columns
+	 (org-table-save-field
+	  ;; Expand equations, then split the equation list between
+	  ;; column formulas and field formulas.
+	  (dolist (eq eqlist)
+	    (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 (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)))
-	 ;; Get the correct line range to process.
-	 (if all
-	     (progn
-	       (setq end (copy-marker (org-table-end)))
-	       (goto-char (setq beg org-table-current-begin-pos))
-	       (cond
-		((re-search-forward org-table-calculate-mark-regexp end t)
-		 ;; This is a table with marked lines, compute selected
-		 ;; lines.
-		 (setq line-re org-table-recalculate-regexp))
-		;; Move forward to the first non-header line.
-		((and (re-search-forward org-table-dataline-regexp end t)
-		      (re-search-forward org-table-hline-regexp end t)
-		      (re-search-forward org-table-dataline-regexp end t))
-		 (setq beg (match-beginning 0)))
-		;; Just leave BEG at the start of the table.
-		(t nil)))
-	   (setq beg (line-beginning-position)
-		 end (copy-marker (line-beginning-position 2))))
-	 (goto-char beg)
-	 ;; Mark named fields untouchable.  Also check if several
-	 ;; field/range formulas try to set the same field.
-	 (remove-text-properties beg end '(:org-untouchable t))
-	 (let ((current-line (count-lines org-table-current-begin-pos
-					  (line-beginning-position)))
-	       seen-fields)
-	   (dolist (eq eqlfield)
-	     (let* ((name (car eq))
-		    (location (assoc name org-table-named-field-locations))
-		    (eq-line (or (nth 1 location)
-				 (and (string-match "\\`@\\([0-9]+\\)" name)
-				      (aref org-table-dlines
-					    (string-to-number
-					     (match-string 1 name))))))
-		    (reference
-		     (if location
-			 ;; Turn field coordinates associated to NAME
-			 ;; into an absolute reference.
-			 (format "@%d$%d"
-				 (org-table-line-to-dline eq-line)
-				 (nth 2 location))
-		       name)))
-	       (when (member reference seen-fields)
-		 (user-error "Several field/range formulas try to set %s"
-			     reference))
-	       (push reference seen-fields)
-	       (when (or all (eq eq-line current-line))
-		 (org-table-goto-field name)
-		 (org-table-put-field-property :org-untouchable t)))))
-	 ;; Evaluate the column formulas, but skip fields covered by
-	 ;; field formulas.
-	 (goto-char beg)
-	 (while (re-search-forward line-re end t)
-	   (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
-	     ;; Unprotected line, recalculate.
-	     (cl-incf cnt)
-	     (when all
-	       (setq log-last-time
-		     (org-table-message-once-per-second
-		      log-last-time
-		      "Re-applying formulas to full table...(line %d)" cnt)))
-	     (if (markerp org-last-recalc-line)
-		 (move-marker org-last-recalc-line (line-beginning-position))
-	       (setq org-last-recalc-line
-		     (copy-marker (line-beginning-position))))
-	     (dolist (entry eqlcol)
-	       (goto-char org-last-recalc-line)
-	       (org-table-goto-column
-		(string-to-number (substring (car entry) 1)) nil 'force)
-	       (unless (get-text-property (point) :org-untouchable)
-		 (org-table-eval-formula
-		  nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
-	 ;; Evaluate the field formulas.
-	 (dolist (eq eqlfield)
-	   (let ((reference (car eq))
-		 (formula (cdr eq)))
-	     (setq log-last-time
-		   (org-table-message-once-per-second
-		    (and all log-last-time)
-		    "Re-applying formula to field: %s" (car eq)))
-	     (org-table-goto-field
-	      reference
-	      ;; Possibly create a new column, as long as
-	      ;; `org-table-formula-create-columns' allows it.
-	      (let ((column-count (progn (end-of-line)
-					 (1- (org-table-current-column)))))
-		(lambda (column)
-		  (when (> column 1000)
-		    (user-error "Formula column target too large"))
-		  (and (> column column-count)
-		       (or (eq org-table-formula-create-columns t)
-			   (and (eq org-table-formula-create-columns 'warn)
-				(progn
-				  (org-display-warning
-				   "Out-of-bounds formula added columns")
-				  t))
-			   (and (eq org-table-formula-create-columns 'prompt)
-				(yes-or-no-p
-				 "Out-of-bounds formula.  Add columns? "))
-			   (user-error
-			    "Missing columns in the table.  Aborting"))))))
-	     (org-table-eval-formula nil formula t t t t))))
-	;; Clean up markers and internal text property.
-	(remove-text-properties (point-min) (point-max) '(org-untouchable t))
-	(set-marker end nil)
+				       old-lhs
+				       new))
+			 new))
+		      (t old-lhs)))))
+	      (if (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)))
+	  ;; Get the correct line range to process.
+	  (if all
+	      (progn
+		(setq end (copy-marker (org-table-end)))
+		(goto-char (setq beg org-table-current-begin-pos))
+		(cond
+		 ((re-search-forward org-table-calculate-mark-regexp end t)
+		  ;; This is a table with marked lines, compute selected
+		  ;; lines.
+		  (setq line-re org-table-recalculate-regexp))
+		 ;; Move forward to the first non-header line.
+		 ((and (re-search-forward org-table-dataline-regexp end t)
+		       (re-search-forward org-table-hline-regexp end t)
+		       (re-search-forward org-table-dataline-regexp end t))
+		  (setq beg (match-beginning 0)))
+		 ;; Just leave BEG at the start of the table.
+		 (t nil)))
+	    (setq beg (line-beginning-position)
+		  end (copy-marker (line-beginning-position 2))))
+	  (goto-char beg)
+	  ;; Mark named fields untouchable.  Also check if several
+	  ;; field/range formulas try to set the same field.
+	  (remove-text-properties beg end '(:org-untouchable t))
+	  (let ((current-line (count-lines org-table-current-begin-pos
+					   (line-beginning-position)))
+		seen-fields)
+	    (dolist (eq eqlfield)
+	      (let* ((name (car eq))
+		     (location (assoc name org-table-named-field-locations))
+		     (eq-line (or (nth 1 location)
+				  (and (string-match "\\`@\\([0-9]+\\)" name)
+				       (aref org-table-dlines
+					     (string-to-number
+					      (match-string 1 name))))))
+		     (reference
+		      (if location
+			  ;; Turn field coordinates associated to NAME
+			  ;; into an absolute reference.
+			  (format "@%d$%d"
+				  (org-table-line-to-dline eq-line)
+				  (nth 2 location))
+			name)))
+		(when (member reference seen-fields)
+		  (user-error "Several field/range formulas try to set %s"
+			      reference))
+		(push reference seen-fields)
+		(when (or all (eq eq-line current-line))
+		  (org-table-goto-field name)
+		  (org-table-put-field-property :org-untouchable t)))))
+	  ;; Evaluate the column formulas, but skip fields covered by
+	  ;; field formulas.
+	  (goto-char beg)
+	  (while (re-search-forward line-re end t)
+	    (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
+	      ;; Unprotected line, recalculate.
+	      (cl-incf cnt)
+	      (when all
+		(setq log-last-time
+		      (org-table-message-once-per-second
+		       log-last-time
+		       "Re-applying formulas to full table...(line %d)" cnt)))
+	      (if (markerp org-last-recalc-line)
+		  (move-marker org-last-recalc-line (line-beginning-position))
+		(setq org-last-recalc-line
+		      (copy-marker (line-beginning-position))))
+	      (dolist (entry eqlcol)
+		(goto-char org-last-recalc-line)
+		(org-table-goto-column
+		 (string-to-number (substring (car entry) 1)) nil 'force)
+		(unless (get-text-property (point) :org-untouchable)
+		  (org-table-eval-formula
+		   nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
+	  ;; Evaluate the field formulas.
+	  (dolist (eq eqlfield)
+	    (let ((reference (car eq))
+		  (formula (cdr eq)))
+	      (setq log-last-time
+		    (org-table-message-once-per-second
+		     (and all log-last-time)
+		     "Re-applying formula to field: %s" (car eq)))
+	      (org-table-goto-field
+	       reference
+	       ;; Possibly create a new column, as long as
+	       ;; `org-table-formula-create-columns' allows it.
+	       (let ((column-count (progn (end-of-line)
+					  (1- (org-table-current-column)))))
+		 (lambda (column)
+		   (when (> column 1000)
+		     (user-error "Formula column target too large"))
+		   (and (> column column-count)
+			(or (eq org-table-formula-create-columns t)
+			    (and (eq org-table-formula-create-columns 'warn)
+				 (progn
+				   (org-display-warning
+				    "Out-of-bounds formula added columns")
+				   t))
+			    (and (eq org-table-formula-create-columns 'prompt)
+				 (yes-or-no-p
+				  "Out-of-bounds formula.  Add columns? "))
+			    (user-error
+			     "Missing columns in the table.  Aborting"))))))
+	      (org-table-eval-formula nil formula t t t t)))
+	  ;; Clean up markers and internal text property.
+	  (remove-text-properties (point-min) (point-max) '(:org-untouchable t))
+	  (set-marker end nil)))
 	(unless noalign
 	  (when org-table-may-need-update (org-table-align))
 	  (when all
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 7af5c9f..8f83c5d 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -3025,7 +3025,14 @@ See also `test-org-table/copy-field'."
       (org-table-toggle-column-width)
       (org-table-align)
       (mapcar (lambda (o) (overlay-get o 'help-echo))
-	      (overlays-in (line-beginning-position) (line-end-position)))))))
+	      (overlays-in (line-beginning-position) (line-end-position))))))
+  ;; Recalculating formulas doesn't change shrunk state.
+  (should
+   (equal "2"
+	  (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
+	    (org-table-toggle-column-width)
+	    (org-table-recalculate)
+	    (overlay-get (car (overlays-at (point))) 'help-echo)))))