From: Nathaniel Flath <flat0103@gmail.com>
To: Nathaniel Flath <flat0103@gmail.com>,
Michael Brand <michael.ch.brand@gmail.com>,
org-mode List <emacs-orgmode@gnu.org>
Subject: Re: [PATH] Speedups to org-table-recalculate
Date: Sun, 7 Dec 2014 23:35:03 -0800 [thread overview]
Message-ID: <CAPrg3HDvBWM7MjhKAaN_VzrTsxgZNKSOrKc9H8V=O26AZqbn3g@mail.gmail.com> (raw)
In-Reply-To: <87sigt1wge.fsf@nicolasgoaziou.fr>
[-- Attachment #1.1: Type: text/plain, Size: 1105 bytes --]
Fixed.
On Fri, Dec 5, 2014 at 3:57 PM, Nicolas Goaziou <mail@nicolasgoaziou.fr>
wrote:
> Nathaniel Flath <flat0103@gmail.com> writes:
>
> > Sorry, that was incorrect - real patches attached.
>
> Thanks.
>
> > +(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)
>
> The docstring seems incorrect, as the function always returns T1, no
> matter if a message is printed or not.
>
> > + (setq log-last-time
> > + (org-table-message-once-per-second
> > + (when all log-last-time)
>
> Nitpick: (and all log-last-time)
>
> > + (when all log-last-time)
>
> Ditto.
> > + (when all log-first-time)
>
> Ditto.
>
>
> Regards,
>
[-- Attachment #1.2: Type: text/html, Size: 1704 bytes --]
[-- Attachment #2: 0001-org-table.el-org-table-recalculate-early-returns(1).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: 0001-org-table.el-org-table-recalculate-is-quieter.patch --]
[-- Type: application/octet-stream, Size: 4749 bytes --]
From f90d75048660a2995fdcb07b030c83e580c4aa9f Mon Sep 17 00:00:00 2001
From: Nathaniel Flath <flat0103@gmail.com>
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 | 44 +++++++++++++++++++++++++++++++++++---------
1 file changed, 35 insertions(+), 9 deletions(-)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 2139d86..6c9f4bf 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -2995,6 +2995,17 @@ 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)))
+ (if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1))))
+ (progn (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 +3030,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 +3081,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 +3105,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
+ (and 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 +3121,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 +3138,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
+ (and 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 +3170,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.9.3 (Apple Git-50)
next prev parent reply other threads:[~2014-12-08 7:35 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
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 [this message]
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='CAPrg3HDvBWM7MjhKAaN_VzrTsxgZNKSOrKc9H8V=O26AZqbn3g@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).