From 2945c1e8c50f08d09f14abad4add0b187f65c9f7 Mon Sep 17 00:00:00 2001 From: Nathaniel Flath Date: Sun, 19 Oct 2014 21:04:31 -0400 Subject: [PATCH] org-table.el: org-table-recalculate early returns * lisp/org-table.el (org-table-recalculate): Add early return. TINYCHANGE --- lisp/org-table.el | 263 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 134 insertions(+), 129 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 06a8ab728..06c591716 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -3034,136 +3034,141 @@ known that the table will be realigned a little later anyway." seen-fields lhs1 beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (if (string-match "^@-?I+" (car x)) - (user-error "Can't assign to hline relative reference")) - (when (string-match "\\`$[<>]" (car x)) - (setq lhs1 (car x)) - (setq x (cons (substring - (org-table-formula-handle-first/last-rc - (car x)) 1) - (cdr x))) - (if (assoc (car x) eqlist1) - (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" + (when eqlist + (setq eqlist + (mapcar + (lambda (x) + (if (string-match "^@-?I+" (car x)) + (user-error "Can't assign to hline relative reference")) + (when (string-match "\\`$[<>]" (car x)) + (setq lhs1 (car x)) + (setq x (cons (substring + (org-table-formula-handle-first/last-rc + (car x)) 1) + (cdr x))) + (if (assoc (car x) eqlist1) + (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" lhs1 (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 - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - ;; Expand ranges in lhs of formulas - (setq eqlname (org-table-expand-lhs-ranges eqlname)) - - ;; Get the correct line range to process - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (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 - (if (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)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchable. - ;; Also check if several field/range formulas try to set the same field. - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (setq name1 name) - (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) - (nth 2 a)))) - (when (member name1 seen-fields) - (user-error "Several field/range formulas try to set %s" name1)) - (push name1 seen-fields) - - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (condition-case nil - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (error (user-error "Invalid row number in %s" - name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (org-goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - (setq eqlname1 (nreverse eqlname1)) - - ;; Now 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 - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (org-goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (org-goto-line (nth 1 eq)) - (let ((column-target (nth 2 eq))) - (when (> column-target 1000) - (user-error "Formula column target too large")) - (let* ((column-count (progn (end-of-line) - (1- (org-table-current-column)))) - (create-new-column - (and (> column-target 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?")))))) - (org-table-goto-column column-target nil create-new-column)) - - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis))) - - (org-goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (org-goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) + (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 + (while (setq eq (pop eqlist)) + (if (<= (string-to-char (car eq)) ?9) + (push eq eqlnum) + (push eq eqlname))) + (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) + ;; Expand ranges in lhs of formulas + (setq eqlname (org-table-expand-lhs-ranges eqlname)) + + ;; Get the correct line range to process + (if all + (progn + (setq end (move-marker (make-marker) (1+ (org-table-end)))) + (goto-char (setq beg (org-table-begin))) + (if (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 + (if (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)) + nil))) ;; just leave beg where it is + (setq beg (point-at-bol) + end (move-marker (make-marker) (1+ (point-at-eol))))) + (goto-char beg) + (and all (message "Re-applying formulas to full table...")) + + ;; First find the named fields, and mark them untouchable. + ;; Also check if several field/range formulas try to set the same field. + (remove-text-properties beg end '(org-untouchable t)) + (while (setq eq (pop eqlname)) + (setq name (car eq) + a (assoc name org-table-named-field-locations)) + (setq name1 name) + (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) + (nth 2 a)))) + (when (member name1 seen-fields) + (user-error "Several field/range formulas try to set %s" name1)) + (push name1 seen-fields) + + (and (not a) + (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) + (setq a (list name + (condition-case nil + (aref org-table-dlines + (string-to-number (match-string 1 name))) + (error (user-error "Invalid row number in %s" + name))) + (string-to-number (match-string 2 name))))) + (when (and a (or all (equal (nth 1 a) thisline))) + (message "Re-applying formula to field: %s" name) + (org-goto-line (nth 1 a)) + (org-table-goto-column (nth 2 a)) + (push (append a (list (cdr eq))) eqlname1) + (org-table-put-field-property :org-untouchable t))) + (setq eqlname1 (nreverse eqlname1)) + + ;; Now 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 + (and all (message "Re-applying formulas to full table...(line %d)" + (setq cnt (1+ cnt)))) + (setq org-last-recalc-line (org-current-line)) + (setq eql eqlnum) + (while (setq entry (pop eql)) + (org-goto-line org-last-recalc-line) + (org-table-goto-column (string-to-number (car entry)) nil 'force) + (unless (get-text-property (point) :org-untouchable) + (org-table-eval-formula + nil (cdr entry) + 'noalign 'nocst 'nostore 'noanalysis))))) + + ;; Now evaluate the field formulas + (while (setq eq (pop eqlname1)) + (message "Re-applying formula to field: %s" (car eq)) + (org-goto-line (nth 1 eq)) + (let ((column-target (nth 2 eq))) + (when (> column-target 1000) + (user-error "Formula column target too large")) + (let* ((column-count (progn (end-of-line) + (1- (org-table-current-column)))) + (create-new-column + (and (> column-target 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?")))))) + (org-table-goto-column column-target nil create-new-column)) + + (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst + 'nostore 'noanalysis))) + + (org-goto-line thisline) + (org-table-goto-column thiscol) + (remove-text-properties (point-min) (point-max) '(org-untouchable t)) + (or noalign (and org-table-may-need-update (org-table-align)) + (and all (message "Re-applying formulas to %d lines...done" cnt))) + + ;; back to initial position + (message "Re-applying formulas...done") + (org-goto-line thisline) + (org-table-goto-column thiscol) + (or noalign (and org-table-may-need-update (org-table-align)) + (and all (message "Re-applying formulas...done"))))))) ;;;###autoload (defun org-table-iterate (&optional arg) -- 2.11.4.GIT