diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2019-04-13 09:30:55 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2019-04-13 09:40:27 +0200 |
commit | 222408d70a3674f06ddd6b77e4e1126c602e7361 (patch) | |
tree | 5b252014c1707e667e03380a70c6708e8d68fb22 | |
parent | 96b507bea8da59db8b8bef43f6e755a8455e809d (diff) | |
download | org-mode-222408d70a3674f06ddd6b77e4e1126c602e7361.tar.gz |
org-table: Prevent expanding columns upon applying formulas
* lisp/org-table.el (org-table-recalculate): Prevent expanding columns
upon applying formulas.
* testing/lisp/test-org-table.el (test-org-table/shrunk-columns): Add
test.
Reported-by: Nick Dokos <ndokos@gmail.com>
<http://lists.gnu.org/r/emacs-orgmode/2019-04/msg00079.html>
-rw-r--r-- | lisp/org-table.el | 265 | ||||
-rw-r--r-- | testing/lisp/test-org-table.el | 9 |
2 files changed, 141 insertions, 133 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el index 8dada1c..54ab25e 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -3224,139 +3224,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 ecef7ea..19dd2b7 100644 --- a/testing/lisp/test-org-table.el +++ b/testing/lisp/test-org-table.el @@ -2640,7 +2640,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))))) |