emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATH] Speedups to org-table-recalculate
@ 2014-07-29 20:03 Nathaniel Flath
  2014-07-29 21:30 ` Bastien
  2014-08-01 21:56 ` Michael Brand
  0 siblings, 2 replies; 34+ messages in thread
From: Nathaniel Flath @ 2014-07-29 20:03 UTC (permalink / raw)
  To: org-mode List


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

This patch speeds up org-table-recalculate by removing all 'message'
function calls.  Additionally adds an early check for whether there are any
formulas and only executes the rest of the function if so.

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

[-- Attachment #2: org-table-speedup.patch --]
[-- Type: application/octet-stream, Size: 9919 bytes --]

diff --git a/lisp/org-table.el b/lisp/org-table.el
index bc32c45..f912bcc 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -42,7 +42,7 @@
 		  (string backend &optional body-only ext-plist))
 (declare-function aa2u "ext:ascii-art-to-unicode" ())
 (declare-function calc-eval "calc" (str &optional separator &rest args))
-		  
+
 (defvar orgtbl-mode) ; defined below
 (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
 (defvar constants-unit-system)
@@ -2768,7 +2768,7 @@ not overwrite the stored one."
 	    (user-error "Invalid field specifier \"%s\""
 			(match-string 0 form)))
 	  (setq form (replace-match repl t t form)))
-	
+
 	(if lispp
 	    (setq ev (condition-case nil
 			 (eval (eval (read form)))
@@ -3074,119 +3074,112 @@ 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"
-				   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))
-	(org-table-goto-column (nth 2 eq))
-	(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"))))))
+      (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)
+
+	;; 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)))
+	    (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
+	    (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))
+	  (org-goto-line (nth 1 eq))
+	  (org-table-goto-column (nth 2 eq))
+	  (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)))
+
+	;; back to initial position
+	(org-goto-line thisline)
+	(org-table-goto-column thiscol)
+	(or noalign (and org-table-may-need-update (org-table-align)))))))
 
 ;;;###autoload
 (defun org-table-iterate (&optional arg)

^ permalink raw reply related	[flat|nested] 34+ messages in thread

end of thread, other threads:[~2014-12-14 21:07 UTC | newest]

Thread overview: 34+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
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
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

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).