From 8a377874e97c3b8ae92a9c33a03238daf77fe480 Mon Sep 17 00:00:00 2001 From: Nathaniel Flath Date: Wed, 12 Nov 2014 17:15:03 +0530 Subject: [PATCH] org-table.el: org-table-recalculate is quieter * lisp/org-table.el (org-table-recalculate): Removed message for start of processing. When ALL is t, messages are printed at most once per second. --- lisp/org-table.el | 47 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..a55a4ce 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,6 +2995,20 @@ list, 'literal is for the format specifier L." elements ",") "]")))) +(defun org-table-message-once-per-second (t1 &rest args) + "If there has been more than one second since T1, display message. +ARGS are passed as arguments to the 'message' function. Returns +current time if a message is printed, otherwise returns t1.. If +T1 is nil, always messages." + (let ((curtime (current-time))) + (when (or (not t1) (< 0 (nth 1 (time-subtract curtime t1)))) + (apply message args) + curtime)) + t1) + + + + ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. @@ -3019,6 +3033,8 @@ known that the table will be realigned a little later anyway." (line-re org-table-dataline-regexp) (thisline (org-current-line)) (thiscol (org-table-current-column)) + (log-first-time (current-time)) + (log-last-time log-first-time) seen-fields lhs1 beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) ;; Insert constants in all formulas @@ -3068,7 +3084,6 @@ known that the table will be realigned a little later anyway." (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. @@ -3093,7 +3108,10 @@ known that the table will be realigned a little later anyway." 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) + (setq log-last-time + (org-table-message-once-per-second + (when all log-last-time) + "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) @@ -3106,8 +3124,11 @@ known that the table will be realigned a little later anyway." (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 cnt (1+ cnt)) + (and all (setq log-last-time + (org-table-message-once-per-second + log-last-time + "Re-applying formulas to full table...(line %d)" cnt))) (setq org-last-recalc-line (org-current-line)) (setq eql eqlnum) (while (setq entry (pop eql)) @@ -3120,7 +3141,10 @@ known that the table will be realigned a little later anyway." ;; Now evaluate the field formulas (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) + (setq log-last-time + (org-table-message-once-per-second + (when all log-last-time) + "Re-applying formula to field: %s" (car eq))) (org-goto-line (nth 1 eq)) (let ((column-target (nth 2 eq))) (when (> column-target 1000) @@ -3149,14 +3173,19 @@ known that the table will be realigned a little later anyway." (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))) + (and all (org-table-message-once-per-second + log-first-time + "Re-applying formulas to %d lines...done" cnt))) + ;; back to initial position - (message "Re-applying formulas...done") + (org-table-message-once-per-second + (when all log-first-time) + "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"))))))) + (or noalign (and org-table-may-need-update (org-table-align))))))) ;;;###autoload (defun org-table-iterate (&optional arg) -- 1.8.5.2 (Apple Git-48)