emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Nathaniel Flath <flat0103@gmail.com>
To: Michael Brand <michael.ch.brand@gmail.com>
Cc: org-mode List <emacs-orgmode@gnu.org>
Subject: Re: [PATH] Speedups to org-table-recalculate
Date: Sun, 9 Nov 2014 18:18:13 +0800	[thread overview]
Message-ID: <CAPrg3HDm-cz=pDz21A=Cf9OnWGV07J7CSx3NzuVd=W+MeAYE3w@mail.gmail.com> (raw)
In-Reply-To: <CALn3zojScmbeU8ON6r-wyYXJJNbfuj2BbvN=co9FSxHqnoqihA@mail.gmail.com>


[-- Attachment #1.1: Type: text/plain, Size: 26 bytes --]

Updated patches attached.

[-- Attachment #1.2: Type: text/html, Size: 51 bytes --]

[-- Attachment #2: 0001-org-table.el-org-table-recalculate-early-returns.patch --]
[-- Type: application/octet-stream, Size: 11547 bytes --]

From eaf1211460f4219002aacbbc33d4cc58574bf7c4 Mon Sep 17 00:00:00 2001
From: Nathaniel Flath <flat0103@gmail.com>
Date: Sun, 19 Oct 2014 21:04:31 -0400
Subject: [PATCH 1/2] org-table.el: org-table-recalculate early returns

* lisp/org-table.el (org-table-recalculate): Add early return.
---
 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 3db6087..816709e 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3040,136 +3040,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)
-- 
1.8.5.2 (Apple Git-48)


[-- Attachment #3: 0002-org-table.el-org-table-recalculate-is-quieter.patch --]
[-- Type: application/octet-stream, Size: 4816 bytes --]

From 74ce1ac6f174de5efa9a118a44da0f165856fdf8 Mon Sep 17 00:00:00 2001
From: Nathaniel Flath <flat0103@gmail.com>
Date: Sun, 19 Oct 2014 21:55:05 -0400
Subject: [PATCH 2/2] 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 | 45 ++++++++++++++++++++++++++++++++++++---------
 1 file changed, 36 insertions(+), 9 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 816709e..851f79d 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3013,6 +3013,19 @@ list, 'literal is for the format specifier L."
 		(push (cons (match-string 1 e) (match-string 2 e)) cst)))
 	    (setq org-table-formula-constants-local cst)))))))
 
+(defmacro org-table-execute-once-per-second (t1 &rest body)
+  "If there has been more than one second since T1, execute BODY.
+Updates T1 to 'current-time' if this condition is met. If T1 is
+nil, always execute body."
+  `(if ,t1
+       (let ((curtime (current-time)))
+	 (when (< 0 (nth 1 (time-subtract curtime ,t1)))
+	   (setq ,t1 curtime)
+	   ,@body))
+     ,@body))
+
+(def-edebug-spec org-table-execute-once-per-second (form body))
+
 ;;;###autoload
 (defun org-table-recalculate (&optional all noalign)
   "Recalculate the current table line by applying all stored formulas.
@@ -3037,6 +3050,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
@@ -3086,7 +3101,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.
@@ -3111,7 +3125,9 @@ 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)
+	    (org-table-execute-once-per-second
+	     (when all log-last-time)
+	     (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)
@@ -3124,8 +3140,12 @@ 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 (org-table-execute-once-per-second
+		      log-last-time
+		      (message
+		       "Re-applying formulas to full table...(line %d)"
+		       )))
 	    (setq org-last-recalc-line (org-current-line))
 	    (setq eql eqlnum)
 	    (while (setq entry (pop eql))
@@ -3138,7 +3158,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))
+	  (org-table-execute-once-per-second
+	   (when all log-last-time)
+	   (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)
@@ -3167,14 +3190,18 @@ 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-execute-once-per-second
+		      log-first-time
+		      (message "Re-applying formulas to %d lines...done"))))
+
+	(org-table-execute-once-per-second
+	 (when all log-first-time)
+	 (message "Re-applying formulas...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")))))))
+	(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)


  reply	other threads:[~2014-11-09 10:18 UTC|newest]

Thread overview: 34+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2014-07-29 20:03 [PATH] Speedups to org-table-recalculate Nathaniel Flath
2014-07-29 21:30 ` Bastien
2014-07-29 21:35   ` Nathaniel Flath
2014-07-29 21:42     ` Bastien
2014-08-01 21:56 ` Michael Brand
2014-08-07 22:57   ` Nathaniel Flath
2014-08-17 13:39     ` Michael Brand
2014-10-10  5:56       ` Nathaniel Flath
2014-10-10 10:35         ` Michael Brand
2014-10-10 19:43           ` Nathaniel Flath
2014-10-11 16:16             ` Michael Brand
2014-10-18  5:11               ` Nathaniel Flath
2014-10-19 19:57                 ` Michael Brand
2014-10-20  1:56                   ` Nathaniel Flath
2014-10-20 19:41                     ` Michael Brand
2014-10-26  0:27                       ` Nathaniel Flath
2014-10-26 19:58                         ` Michael Brand
2014-11-09 10:18                           ` Nathaniel Flath [this message]
2014-11-09 15:42                             ` Michael Brand
2014-11-12 11:51                               ` Nathaniel Flath
2014-11-12 19:09                                 ` Michael Brand
2014-11-14 13:33                                   ` Nathaniel Flath
2014-11-14 17:40                                     ` Michael Brand
2014-11-14 18:00                                       ` Nathaniel Flath
2014-11-14 20:19                                         ` Michael Brand
2014-11-14 22:37                                           ` Nicolas Goaziou
2014-11-21  9:10                                             ` Nathaniel Flath
2014-11-21 23:30                                               ` Nicolas Goaziou
2014-12-01  6:02                                                 ` Nathaniel Flath
2014-12-01  6:15                                                   ` Nathaniel Flath
2014-12-05 23:57                                                     ` Nicolas Goaziou
2014-12-08  7:35                                                       ` Nathaniel Flath
2014-12-08 12:56                                                         ` Michael Brand
2014-12-14 21:07                                                         ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CAPrg3HDm-cz=pDz21A=Cf9OnWGV07J7CSx3NzuVd=W+MeAYE3w@mail.gmail.com' \
    --to=flat0103@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    --cc=michael.ch.brand@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).