* [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
* Re: [PATH] Speedups to org-table-recalculate 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-08-01 21:56 ` Michael Brand 1 sibling, 1 reply; 34+ messages in thread From: Bastien @ 2014-07-29 21:30 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel, Nathaniel Flath <flat0103@gmail.com> writes: > 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. The patch is bigger than what can be accepted without requiring a copyright assignment. Here is the form you would need to send if you agree: http://orgmode.org/cgit.cgi/org-mode.git/plain/request-assign-future.txt It can take a month, especially since this is summer time. Thanks in advance! -- Bastien ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-07-29 21:30 ` Bastien @ 2014-07-29 21:35 ` Nathaniel Flath 2014-07-29 21:42 ` Bastien 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-07-29 21:35 UTC (permalink / raw) To: Bastien; +Cc: org-mode List [-- Attachment #1: Type: text/plain, Size: 958 bytes --] Hi Bastien, I believe I did that a long time ago, juste been inactive. I've definitely contributed to org before, although searching through my email I can only find a copyright assignment for Emacs itself (dated 8/23/09), do I have to re-do this? Thanks, Nathaniel Flath On Tue, Jul 29, 2014 at 2:30 PM, Bastien <bzg@gnu.org> wrote: > Hi Nathaniel, > > Nathaniel Flath <flat0103@gmail.com> writes: > > > 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. > > The patch is bigger than what can be accepted without requiring a > copyright assignment. Here is the form you would need to send if > you agree: > > http://orgmode.org/cgit.cgi/org-mode.git/plain/request-assign-future.txt > > It can take a month, especially since this is summer time. > > Thanks in advance! > > -- > Bastien > [-- Attachment #2: Type: text/html, Size: 1640 bytes --] ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-07-29 21:35 ` Nathaniel Flath @ 2014-07-29 21:42 ` Bastien 0 siblings, 0 replies; 34+ messages in thread From: Bastien @ 2014-07-29 21:42 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel, Nathaniel Flath <flat0103@gmail.com> writes: > I believe I did that a long time ago, juste been inactive. I've > definitely contributed to org before, although searching through my > email I can only find a copyright assignment for Emacs itself (dated > 8/23/09), do I have to re-do this? Of course you don't have to redo this -- sorry I forgot. I'll have a look at the patch when I'm back from holidays in three weeks. Thanks, -- Bastien ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-07-29 20:03 [PATH] Speedups to org-table-recalculate Nathaniel Flath 2014-07-29 21:30 ` Bastien @ 2014-08-01 21:56 ` Michael Brand 2014-08-07 22:57 ` Nathaniel Flath 1 sibling, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-08-01 21:56 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Tue, Jul 29, 2014 at 2:03 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > 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. As far as I understand these `message' were added to see the progress of a long lasting recalculation which would not be supported any more with your patch. But I agree that it would be sufficient to report the current field/line only every let's say one second and suppress the others to gain speed for use cases like yours. Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-08-01 21:56 ` Michael Brand @ 2014-08-07 22:57 ` Nathaniel Flath 2014-08-17 13:39 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-08-07 22:57 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1: Type: text/plain, Size: 977 bytes --] Yes, that wouldn't be supported - although certainly in my case what was making it slow *were* the messages. I'd be fine with displaying every second, but I don't see a good way of doing this - do you have any suggestions? On Fri, Aug 1, 2014 at 2:56 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Tue, Jul 29, 2014 at 2:03 PM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > 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. > > As far as I understand these `message' were added to see the progress > of a long lasting recalculation which would not be supported any more > with your patch. But I agree that it would be sufficient to report the > current field/line only every let's say one second and suppress the > others to gain speed for use cases like yours. > > Michael > [-- Attachment #2: Type: text/html, Size: 1499 bytes --] ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-08-07 22:57 ` Nathaniel Flath @ 2014-08-17 13:39 ` Michael Brand 2014-10-10 5:56 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-08-17 13:39 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Thu, Aug 7, 2014 at 4:57 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > I'd be fine with displaying every > second, but I don't see a good way of doing this - do you have any > suggestions? I thought of something like in this example: (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) (while (< row 6543210) (setq row (1+ row)) (when (time-less-p log (current-time)) (setq log (time-add (current-time) '(0 1 0 0))) (message "row %d" row)))) Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-08-17 13:39 ` Michael Brand @ 2014-10-10 5:56 ` Nathaniel Flath 2014-10-10 10:35 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-10-10 5:56 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1: Type: text/plain, Size: 1506 bytes --] Sorry for the late response - missed this for a while. That's still much more slow than not doing it - slightly modifying your example,: (progn (setq start (current-time)) (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) (while (< row 6543210) (setq row (1+ row)) (when (time-less-p log (current-time)) (setq log (time-add (current-time) '(0 1 0 0))) (message "row %d" row)))) (setq end (current-time)) (print (time-subtract end start))) prints (0 43 386499 0) on my computer. Removing the when clause: (progn (setq start (current-time)) (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) (while (< row 6543210) (setq row (1+ row)))) (setq end (current-time)) (print (time-subtract end start))) Results in: (0 1 277641 0) So adding the logging here slows it down by about 43x - It doesn't seem worth it. On Sun, Aug 17, 2014 at 6:39 AM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Thu, Aug 7, 2014 at 4:57 PM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > I'd be fine with displaying every > > second, but I don't see a good way of doing this - do you have any > > suggestions? > > I thought of something like in this example: > > (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) > (while (< row 6543210) > (setq row (1+ row)) > (when (time-less-p log (current-time)) > (setq log (time-add (current-time) '(0 1 0 0))) > (message "row %d" row)))) > > Michael > [-- Attachment #2: Type: text/html, Size: 2454 bytes --] ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-10 5:56 ` Nathaniel Flath @ 2014-10-10 10:35 ` Michael Brand 2014-10-10 19:43 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-10-10 10:35 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Fri, Oct 10, 2014 at 7:56 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > That's still much more slow than not doing it - slightly modifying your > example,: > > (progn > (setq start (current-time)) > (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) > (while (< row 6543210) > (setq row (1+ row)) > (when (time-less-p log (current-time)) > (setq log (time-add (current-time) '(0 1 0 0))) > (message "row %d" row)))) > (setq end (current-time)) > (print (time-subtract end start))) > > prints (0 43 386499 0) on my computer. > > Removing the when clause: > > (progn > (setq start (current-time)) > (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) > (while (< row 6543210) > (setq row (1+ row)))) > (setq end (current-time)) > (print (time-subtract end start))) > > Results in: > (0 1 277641 0) > > So adding the logging here slows it down by about 43x - It doesn't seem > worth it. Your measurement shows that "(when (time-less-p log (current-time)) [...]" takes 6.4 microseconds or can run 150'000 times per second. I would expect it to be negligible compared to what Org has to do for each row or field like parse, calculate, format etc. Otherwise it would mean that Org can perform more or not significantly less than 150'000 rows or fields per second on an appropriate example table. Tersely formulated I expect this performance comparison: nothing or empty loop << a conditional message with time check << Org performs a simple formula on one row or field << an unconditional message Can you make a performance comparison on your table between (a) your patch and (b) without your patch but with "(when (time-less-p log (current-time)) [...]" plus describe or share this table? Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-10 10:35 ` Michael Brand @ 2014-10-10 19:43 ` Nathaniel Flath 2014-10-11 16:16 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-10-10 19:43 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1: Type: text/plain, Size: 3818 bytes --] Mine is a pretty simple table (takes less than a second even in the original case): | Category | Budget | Spent | Remaining | |----------+--------+-------+-----------| | A | 100 | 0 | 100 | | B | 100 | 0 | 100 | | C | 100 | 0 | 100 | | D | 100 | 0 | 100 | | E | 100 | 0 | 100 | | F | 100 | 0 | 100 | | G | 100 | 0 | 100 | | H | 100 | 0 | 100 | | I | 100 | 0 | 100 | | J | 100 | 0 | 100 | | K | 100 | 0 | 100 | | L | 100 | 0 | 100 | | M | 100 | 0 | 100 | | N | 100 | 0 | 100 | | O | 100 | 0 | 100 | | K | 100 | 0 | 100 | |----------+--------+-------+-----------| | Total | 1600 | 0 | 1600 | #+TBLFM: $4=$2-$3::@18$2=vsum(@2$2..@-1)::@18$3=vsum(@2$3..@-1) With the macro: (defmacro time (block) `(let (start end) (setq start (current-time)) ,block (setq end (current-time)) (print (time-subtract end start)))) and running (time (org-table-recalculate t)) Original recalculation: (0 0 396224 0) Version w/ time checks for per-field messages (still always printing at beginning/end of processing):(0 0 56929 0) Version w/ time checks and removing all beginning/end of processing messages: (0 0 22077 0) My patch: (0 0 17405 0) So, it's still a 26% performance degradation to going with the patch and removing the 'global' messaging, but I could probably live with that - qualitatively, there doesn't seem to be too much difference between my patch and doing that, but the original version is obviously slow and with the on-begin/end calculation messages the delay is much more noticable. On Fri, Oct 10, 2014 at 3:35 AM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Fri, Oct 10, 2014 at 7:56 AM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > That's still much more slow than not doing it - slightly modifying your > > example,: > > > > (progn > > (setq start (current-time)) > > (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) > > (while (< row 6543210) > > (setq row (1+ row)) > > (when (time-less-p log (current-time)) > > (setq log (time-add (current-time) '(0 1 0 0))) > > (message "row %d" row)))) > > (setq end (current-time)) > > (print (time-subtract end start))) > > > > prints (0 43 386499 0) on my computer. > > > > Removing the when clause: > > > > (progn > > (setq start (current-time)) > > (let ((row 0) (log (time-add (current-time) '(0 1 0 0)))) > > (while (< row 6543210) > > (setq row (1+ row)))) > > (setq end (current-time)) > > (print (time-subtract end start))) > > > > Results in: > > (0 1 277641 0) > > > > So adding the logging here slows it down by about 43x - It doesn't seem > > worth it. > > Your measurement shows that "(when (time-less-p log (current-time)) > [...]" takes 6.4 microseconds or can run 150'000 times per second. I > would expect it to be negligible compared to what Org has to do for > each row or field like parse, calculate, format etc. Otherwise it > would mean that Org can perform more or not significantly less than > 150'000 rows or fields per second on an appropriate example table. > > Tersely formulated I expect this performance comparison: nothing or > empty loop << a conditional message with time check << Org performs a > simple formula on one row or field << an unconditional message > > Can you make a performance comparison on your table between (a) your > patch and (b) without your patch but with "(when (time-less-p log > (current-time)) [...]" plus describe or share this table? > > Michael > [-- Attachment #2: Type: text/html, Size: 5272 bytes --] ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-10 19:43 ` Nathaniel Flath @ 2014-10-11 16:16 ` Michael Brand 2014-10-18 5:11 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-10-11 16:16 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Fri, Oct 10, 2014 at 9:43 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > Mine is a pretty simple table (takes less than a second even in the original > case): Earlier I assumed that the issue is a very high number of messages from the loops. Now your example table clarifies to me that the issue is that already just one single message can take a significant time of a message-less table recalculation (your 17 ms). Only with this I understand now why you want to remove also the beginning/end processing messages. Good point as it should be noticeable at least for org-table-iterate-buffer-tables in a buffer with many tables where each one takes a short time to recalculate. I really wonder what the reason is that this (progn (message "%d" (random)) ;; Prevent collapsing of message lines. (time (message nil))) in a terminal (emacs -nw) shows most of the times only 0.05 to 0.10 ms but in a window it shows most of the times 8 to 22 ms (here: GNU Emacs 24.3.1 on Mac OS X 10.9). Which Emacs version and OS are you using? For your patch I suggest to remove only the first message and to add the time check to all other messages. This should not make the patch noticeably slower but would keep showing the progress for table recalculations that last more than one second. To clean up the last loop message from the mode line I suggest to check the end messages against the very first log time in contrast to the next log time used for the loop messages (variables "log_first" and "log_next" instead of just "log"). I suggest you split your patch: One for "(when eqlist" and one for the messages. The change with the messages will then become human readable also with a simple line diff. > Original recalculation: (0 0 396224 0) > Version w/ time checks for per-field messages (still always printing at > beginning/end of processing):(0 0 56929 0) > Version w/ time checks and removing all beginning/end of processing > messages: (0 0 22077 0) > My patch: (0 0 17405 0) I could not reproduce a reliable difference between the last two. As expected both did not log any message. Can you? Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-11 16:16 ` Michael Brand @ 2014-10-18 5:11 ` Nathaniel Flath 2014-10-19 19:57 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-10-18 5:11 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1.1: Type: text/plain, Size: 2513 bytes --] Hi On Sat, Oct 11, 2014 at 12:16 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Fri, Oct 10, 2014 at 9:43 PM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > Mine is a pretty simple table (takes less than a second even in the > original > > case): > > Earlier I assumed that the issue is a very high number of messages > from the loops. Now your example table clarifies to me that the issue > is that already just one single message can take a significant time of > a message-less table recalculation (your 17 ms). > > Only with this I understand now why you want to remove also the > beginning/end processing messages. Good point as it should be > noticeable at least for org-table-iterate-buffer-tables in a buffer > with many tables where each one takes a short time to recalculate. > > I really wonder what the reason is that this > > (progn > (message "%d" (random)) ;; Prevent collapsing of message lines. > (time (message nil))) > > in a terminal (emacs -nw) shows most of the times only 0.05 to 0.10 ms > but in a window it shows most of the times 8 to 22 ms (here: GNU Emacs > 24.3.1 on Mac OS X 10.9). Which Emacs version and OS are you using? > I'm running 24.3.1 on Mac OS X 10.8.4. > > For your patch I suggest to remove only the first message and to add > the time check to all other messages. This should not make the patch > noticeably slower but would keep showing the progress for table > recalculations that last more than one second. To clean up the last > loop message from the mode line I suggest to check the end messages > against the very first log time in contrast to the next log time used > for the loop messages (variables "log_first" and "log_next" instead of > just "log"). > > I suggest you split your patch: One for "(when eqlist" and one for the > messages. The change with the messages will then become human readable > also with a simple line diff. OK, sounds reasonable. Patches are attached. > > > Original recalculation: (0 0 396224 0) > > > Version w/ time checks for per-field messages (still always printing at > > beginning/end of processing):(0 0 56929 0) > > > Version w/ time checks and removing all beginning/end of processing > > messages: (0 0 22077 0) > > > My patch: (0 0 17405 0) > > I could not reproduce a reliable difference between the last two. As > expected both did not log any message. Can you? > Rrunning more iterations they seemed to be mostly equal. Patches are attached. > > Michael > [-- Attachment #1.2: Type: text/html, Size: 3680 bytes --] [-- Attachment #2: org-table-speedup-1.patch --] [-- Type: application/octet-stream, Size: 10370 bytes --] diff --git a/lisp/org-table.el b/lisp/org-table.el index bc32c45..0335280 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,120 @@ 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) + (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"))))))) ;;;###autoload (defun org-table-iterate (&optional arg) [-- Attachment #3: org-table-speedup-2.patch --] [-- Type: application/octet-stream, Size: 4202 bytes --] diff --git a/lisp/org-table.el b/lisp/org-table.el index 0335280..c30f80c 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -3047,6 +3047,15 @@ 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." + `(let ((curtime (current-time))) + (when (< 0 (nth 1 (time-subtract curtime ,t1))) + (setq ,t1 curtime) + ,@body + ))) + ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. @@ -3071,6 +3080,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 @@ -3119,7 +3130,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. @@ -3144,7 +3154,7 @@ 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 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) @@ -3157,8 +3167,8 @@ 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)))) + (and all (org-table-execute-once-per-second log-last-time (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)) @@ -3170,7 +3180,9 @@ 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)) + (if (not all) (message "Re-applying formula to field: %s" (car eq)) + (org-table-execute-once-per-second log-last-time (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 @@ -3180,14 +3192,14 @@ 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-last-time (message "Re-applying formulas to %d lines...done" cnt)))) ;; back to initial position - (message "Re-applying formulas...done") + (org-table-execute-once-per-second log-first-time (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"))))))) + (and all (org-table-execute-once-per-second log-first-time (message "Re-applying formulas...done")))))))) ;;;###autoload (defun org-table-iterate (&optional arg) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-18 5:11 ` Nathaniel Flath @ 2014-10-19 19:57 ` Michael Brand 2014-10-20 1:56 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-10-19 19:57 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Sat, Oct 18, 2014 at 7:11 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > Patches are attached. I am not an expert for all the following comments, please correct me or contradict where necessary. The patches do not apply on current master, so I did not try them out yet. You might want to add a def-edebug-spec like there is one for many other defmacro in Org. Limit lines to max. 80 chars. It will make it easier for the maintainer Bastien to apply the patches when you format them with git including a changelog etc. as described here http://orgmode.org/worg/org-contribute.html > + (if (not all) (message "Re-applying formula to field: %s" (car eq)) > + (org-table-execute-once-per-second log-last-time (message "Re-applying formula to field: %s" (car eq)))) Good idea to still log always when only one table row is recalculated. The doubling of the message makes it more complicated to maintain its string. I suggest to change the macro to allow (org-table-execute-once-per-second (when all log-last-time) ; Log just always when `all' is nil. (message "Re-applying formula to field: %s" (car eq))) Why not test `all' also for the other message with "to field"? > + ,@body > + ))) Parentheses not alone on an own line. > + (and all (org-table-execute-once-per-second log-last-time (message "Re-applying formulas to %d lines...done" cnt)))) Shouldn't this use `log-first-time'? Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-19 19:57 ` Michael Brand @ 2014-10-20 1:56 ` Nathaniel Flath 2014-10-20 19:41 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-10-20 1:56 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1.1: Type: text/plain, Size: 1763 bytes --] Hi Michael, Thanks for the review! Updated patches attached. I believe I've fixed everything you mentioned - let me know if I missed something. On Sun, Oct 19, 2014 at 3:57 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Sat, Oct 18, 2014 at 7:11 AM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > Patches are attached. > > I am not an expert for all the following comments, please correct me > or contradict where necessary. > > The patches do not apply on current master, so I did not try them out > yet. > > You might want to add a def-edebug-spec like there is one for many > other defmacro in Org. > Limit lines to max. 80 chars. > > It will make it easier for the maintainer Bastien to apply the patches > when you format them with git including a changelog etc. as described > here > http://orgmode.org/worg/org-contribute.html > > > + (if (not all) (message "Re-applying formula to field: %s" > (car eq)) > > + (org-table-execute-once-per-second log-last-time (message > "Re-applying formula to field: %s" (car eq)))) > > Good idea to still log always when only one table row is recalculated. > > The doubling of the message makes it more complicated to maintain its > string. I suggest to change the macro to allow > > (org-table-execute-once-per-second > (when all log-last-time) ; Log just always when `all' is nil. > (message "Re-applying formula to field: %s" (car eq))) > Why not test `all' also for the other message with "to field"? > > > > + ,@body > > + ))) > > > > + (and all (org-table-execute-once-per-second log-last-time > (message "Re-applying formulas to %d lines...done" cnt)))) > > Shouldn't this use `log-first-time'? > > > Michael > [-- Attachment #1.2: Type: text/html, Size: 3168 bytes --] [-- Attachment #2: 0001-org-table.el-Add-early-return-check-to-org-table-rec.patch --] [-- Type: application/octet-stream, Size: 11560 bytes --] From 2b24ffcdfa02b165114412a90874b8f3a9b7f337 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: Add early return check to org-table-recalculate * 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-Print-far-fewer-messages-when-recalcula.patch --] [-- Type: application/octet-stream, Size: 4821 bytes --] From 0d0b2a3744257a274f6e102d9c2dc65dfbf09a1c 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: Print far fewer messages when recalculating tables. * 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 816709e..e5a8ce7 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,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)))) + (and all (org-table-execute-once-per-second + log-last-time + (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)) @@ -3138,7 +3157,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 +3189,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" cnt)))) + + (org-table-execute-once-per-second + 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-20 1:56 ` Nathaniel Flath @ 2014-10-20 19:41 ` Michael Brand 2014-10-26 0:27 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-10-20 19:41 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Mon, Oct 20, 2014 at 3:56 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > Thanks for the review! Updated patches attached. I believe I've fixed > everything you mentioned - Yes, thank you. I tried them out. > let me know if I missed something. > Subject: [PATCH 1/2] org-table.el: Add early return check to > org-table-recalculate > Subject: [PATCH 2/2] org-table.el: Print far fewer messages when recalculating > tables. http://orgmode.org/worg/org-contribute.html says: Line 2 is an empty line. I try to limit my commit subjects to 50 chars which is a rule for some projects and helpful for e. g. git log with certain options. > + (and all (org-table-execute-once-per-second > + log-last-time > + (message > + "Re-applying formulas to full table...(line %d)" > + (setq cnt (1+ cnt))))) Before trying out I have overseen it, setq does not increment on each line any more so it has to move before org-table-execute-once-per-second. Now probably better wrapped in a `when' instead of the original `and' with an added `progn'. > + (org-table-execute-once-per-second > + log-first-time > + (message "Re-applying formulas...done" cnt)) cnt is superfluous. Only during trying out I noticed: This message could still be kept as a feedback at least for single row updates, like e. g. Tab on a row with "#" in the first column, by changing log-first-time to (when all log-first-time). Or more conservative why not leave this message unconditional to avoid that any user could complain for any use case that all feedback messages disappeared like it would be the case for e. g. the typical "C-c C-c" on TBLFM? I think that would be a simple, safe compromise. Otherwise the right but not so simple thing to do would be to log this message for a simple "C-c C-c" on TBLFM and to not log it for only those cases that throw after other feedback messages like e. g. sometimes "C-u C-u C-c C-c" on TBLFM ("Table was already stable"), M-x org-table-iterate-buffer-tables and more. These repetition intensive use cases are the only ones that can profit noticeable from the conditional removal of this last message, aren't they? Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-20 19:41 ` Michael Brand @ 2014-10-26 0:27 ` Nathaniel Flath 2014-10-26 19:58 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-10-26 0:27 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1: Type: text/plain, Size: 3015 bytes --] Hi Michael On Mon, Oct 20, 2014 at 12:41 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Mon, Oct 20, 2014 at 3:56 AM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > Thanks for the review! Updated patches attached. I believe I've fixed > > everything you mentioned - > > Yes, thank you. I tried them out. > > > let me know if I missed something. > > > Subject: [PATCH 1/2] org-table.el: Add early return check to > > org-table-recalculate > > > Subject: [PATCH 2/2] org-table.el: Print far fewer messages when > recalculating > > tables. > > http://orgmode.org/worg/org-contribute.html > says: Line 2 is an empty line. > > I try to limit my commit subjects to 50 chars which is a rule for some > projects and helpful for e. g. git log with certain options. > OK, will fix these in next set of pathces. > > > + (and all (org-table-execute-once-per-second > > + log-last-time > > + (message > > + "Re-applying formulas to full table...(line %d)" > > + (setq cnt (1+ cnt))))) > > Before trying out I have overseen it, setq does not increment on each > line any more so it has to move before > org-table-execute-once-per-second. Now probably better wrapped in a > `when' instead of the original `and' with an added `progn'. > OK, good catch > > > + (org-table-execute-once-per-second > > + log-first-time > > + (message "Re-applying formulas...done" cnt)) > > cnt is superfluous. > OK. > > Only during trying out I noticed: This message could still be kept as > a feedback at least for single row updates, like e. g. Tab on a row > with "#" in the first column, by changing log-first-time to (when all > log-first-time). > > Or more conservative why not leave this message unconditional to avoid > that any user could complain for any use case that all feedback > messages disappeared like it would be the case for e. g. the typical > "C-c C-c" on TBLFM? I think that would be a simple, safe compromise. > I'm fine with adding the (when all log-first-time). I don't want to leave it unconditional because as we discussed before, one message in my case significantly slows down the table recalculation - and if there has been no feedback then we are dealing with a small case where it could be significant. > > Otherwise the right but not so simple thing to do would be to log this > message for a simple "C-c C-c" on TBLFM and to not log it for only > those cases that throw after other feedback messages like e. g. > sometimes "C-u C-u C-c C-c" on TBLFM ("Table was already stable"), M-x > org-table-iterate-buffer-tables and more. These repetition intensive > use cases are the only ones that can profit noticeable from the > conditional removal of this last message, aren't they? > I got tired of having to force tables to be reformated, so I advised org-cycle to always recalculate a table, so I notice whenever I'm in a table. > > Michael > [-- Attachment #2: Type: text/html, Size: 4801 bytes --] ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-26 0:27 ` Nathaniel Flath @ 2014-10-26 19:58 ` Michael Brand 2014-11-09 10:18 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-10-26 19:58 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Sun, Oct 26, 2014 at 2:27 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > I'm fine with adding the (when all log-first-time). I don't want to leave > it unconditional Ok, then I agree on (when all log-first-time). Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-10-26 19:58 ` Michael Brand @ 2014-11-09 10:18 ` Nathaniel Flath 2014-11-09 15:42 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-11-09 10:18 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-09 10:18 ` Nathaniel Flath @ 2014-11-09 15:42 ` Michael Brand 2014-11-12 11:51 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-11-09 15:42 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Sun, Nov 9, 2014 at 11:18 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > Updated patches attached. The second does not apply after the first on today's release_8.3beta-552-ga95cfeb. Unrelated: The second has new closing parentheses on an own line. Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-09 15:42 ` Michael Brand @ 2014-11-12 11:51 ` Nathaniel Flath 2014-11-12 19:09 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-11-12 11:51 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1.1: Type: text/plain, Size: 405 bytes --] New patches attached! On Sun, Nov 9, 2014 at 9:12 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Sun, Nov 9, 2014 at 11:18 AM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > Updated patches attached. > > The second does not apply after the first on today's > release_8.3beta-552-ga95cfeb. Unrelated: The second has new closing > parentheses on an own line. > > Michael > [-- Attachment #1.2: Type: text/html, Size: 849 bytes --] [-- Attachment #2: 0002-org-table.el-org-table-recalculate-is-quieter.patch --] [-- Type: application/octet-stream, Size: 4733 bytes --] From 203b4db889b8cd0bbe3524a93f3bf2df91ca88ba Mon Sep 17 00:00:00 2001 From: Nathaniel Flath <flat0103@gmail.com> Date: Wed, 12 Nov 2014 17:15:03 +0530 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 | 44 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..95532ad 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,6 +2995,19 @@ list, 'literal is for the format specifier L." elements ",") "]")))) +(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. @@ -3019,6 +3032,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 +3083,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 +3107,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) @@ -3106,8 +3122,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 (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)) @@ -3120,7 +3139,9 @@ 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) @@ -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-execute-once-per-second + log-first-time + (message "Re-applying formulas to %d lines...done")))) + ;; back to initial position - (message "Re-applying formulas...done") + (org-table-execute-once-per-second + (when all log-first-time) + (message "Re-applying formulas...done" cnt)) + (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) [-- Attachment #3: 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-12 11:51 ` Nathaniel Flath @ 2014-11-12 19:09 ` Michael Brand 2014-11-14 13:33 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-11-12 19:09 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Wed, Nov 12, 2014 at 12:51 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > New patches attached! Now that they apply I found: > + "Re-applying formulas to full table...(line %d)"))) Missing cnt. > + (message "Re-applying formulas...done" cnt)) Superfluous cnt. Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-12 19:09 ` Michael Brand @ 2014-11-14 13:33 ` Nathaniel Flath 2014-11-14 17:40 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-11-14 13:33 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1.1: Type: text/plain, Size: 451 bytes --] Aaaand another try. On Thu, Nov 13, 2014 at 12:39 AM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Wed, Nov 12, 2014 at 12:51 PM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > New patches attached! > > Now that they apply I found: > > > + "Re-applying formulas to full table...(line %d)"))) > > Missing cnt. > > > + (message "Re-applying formulas...done" cnt)) > > Superfluous cnt. > > Michael > [-- Attachment #1.2: Type: text/html, Size: 974 bytes --] [-- Attachment #2: 0002-org-table.el-org-table-recalculate-is-quieter.patch --] [-- Type: application/octet-stream, Size: 4733 bytes --] From 52f588175944be601b2332d215eb93efcd9ac9de Mon Sep 17 00:00:00 2001 From: Nathaniel Flath <flat0103@gmail.com> Date: Wed, 12 Nov 2014 17:15:03 +0530 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 | 44 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..c797f69 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,6 +2995,19 @@ list, 'literal is for the format specifier L." elements ",") "]")))) +(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. @@ -3019,6 +3032,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 +3083,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 +3107,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) @@ -3106,8 +3122,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 (org-table-execute-once-per-second + log-last-time + (message + "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 +3139,9 @@ 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) @@ -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-execute-once-per-second + log-first-time + (message "Re-applying formulas to %d lines...done")))) + ;; back to initial position - (message "Re-applying formulas...done") + (org-table-execute-once-per-second + (when all log-first-time) + (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) [-- Attachment #3: 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-14 13:33 ` Nathaniel Flath @ 2014-11-14 17:40 ` Michael Brand 2014-11-14 18:00 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-11-14 17:40 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Fri, Nov 14, 2014 at 2:33 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > Aaaand another try. I tested them and got an error because of a missing cnt: > + (message "Re-applying formulas to %d lines...done")))) Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-14 17:40 ` Michael Brand @ 2014-11-14 18:00 ` Nathaniel Flath 2014-11-14 20:19 ` Michael Brand 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-11-14 18:00 UTC (permalink / raw) To: Michael Brand; +Cc: org-mode List [-- Attachment #1.1: Type: text/plain, Size: 445 bytes --] Bleh. Took out the wrong cnt, and that didn't show up in my testing for some reason. On Fri, Nov 14, 2014 at 11:10 PM, Michael Brand <michael.ch.brand@gmail.com> wrote: > Hi Nathaniel > > On Fri, Nov 14, 2014 at 2:33 PM, Nathaniel Flath <flat0103@gmail.com> > wrote: > > Aaaand another try. > > I tested them and got an error because of a missing cnt: > > > + (message "Re-applying formulas to %d lines...done")))) > > Michael > [-- Attachment #1.2: Type: text/html, Size: 911 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: 0002-org-table.el-org-table-recalculate-is-quieter.patch --] [-- Type: application/octet-stream, Size: 4737 bytes --] From d583de737a1b85a622e73d9a995c253f529701c9 Mon Sep 17 00:00:00 2001 From: Nathaniel Flath <flat0103@gmail.com> Date: Wed, 12 Nov 2014 17:15:03 +0530 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 | 44 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..ca0c9aa 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,6 +2995,19 @@ list, 'literal is for the format specifier L." elements ",") "]")))) +(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. @@ -3019,6 +3032,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 +3083,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 +3107,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) @@ -3106,8 +3122,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 (org-table-execute-once-per-second + log-last-time + (message + "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 +3139,9 @@ 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) @@ -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-execute-once-per-second + log-first-time + (message "Re-applying formulas to %d lines...done" cnt)))) + ;; back to initial position - (message "Re-applying formulas...done") + (org-table-execute-once-per-second + (when all log-first-time) + (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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-14 18:00 ` Nathaniel Flath @ 2014-11-14 20:19 ` Michael Brand 2014-11-14 22:37 ` Nicolas Goaziou 0 siblings, 1 reply; 34+ messages in thread From: Michael Brand @ 2014-11-14 20:19 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel On Fri, Nov 14, 2014 at 7:00 PM, Nathaniel Flath <flat0103@gmail.com> wrote: > Bleh. Took out the wrong cnt, and that didn't show up in my testing for > some reason. In my opinion the newest patches can be applied, tests passed on my side. Thank you. Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-14 20:19 ` Michael Brand @ 2014-11-14 22:37 ` Nicolas Goaziou 2014-11-21 9:10 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Nicolas Goaziou @ 2014-11-14 22:37 UTC (permalink / raw) To: Michael Brand; +Cc: Nathaniel Flath, org-mode List Hello, Michael Brand <michael.ch.brand@gmail.com> writes: > In my opinion the newest patches can be applied, tests passed on my > side. Thank you. Thanks. However, I get compilation errors, probably due to the macro `org-table-execute-once-per-second'. In particular, using multiple ",t1" isn't a good idea. BTW, Nathaniel, these patches are no tiny changes. Have you signed FSF papers yet? Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-14 22:37 ` Nicolas Goaziou @ 2014-11-21 9:10 ` Nathaniel Flath 2014-11-21 23:30 ` Nicolas Goaziou 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-11-21 9:10 UTC (permalink / raw) To: Michael Brand, Nathaniel Flath, org-mode List [-- Attachment #1.1: Type: text/plain, Size: 604 bytes --] OK, I think I fixed that. Yes, I have signed FSF papers. On Sat, Nov 15, 2014 at 4:07 AM, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote: > Hello, > > Michael Brand <michael.ch.brand@gmail.com> writes: > > > In my opinion the newest patches can be applied, tests passed on my > > side. Thank you. > > Thanks. > > However, I get compilation errors, probably due to the macro > `org-table-execute-once-per-second'. In particular, using multiple ",t1" > isn't a good idea. > > BTW, Nathaniel, these patches are no tiny changes. Have you signed FSF > papers yet? > > > Regards, > > -- > Nicolas Goaziou > [-- Attachment #1.2: Type: text/html, Size: 1137 bytes --] [-- Attachment #2: 0001-org-table.el-org-table-recalculate-is-quieter.patch --] [-- Type: application/octet-stream, Size: 4755 bytes --] From 7a29b3d808b087d5325bd46512cc45d0c04de1bf 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 | 45 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..447bd22 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,6 +2995,20 @@ list, 'literal is for the format specifier L." elements ",") "]")))) +(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." + `(let ((t1 ,t1)) + (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. @@ -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,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) @@ -3106,8 +3123,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 (org-table-execute-once-per-second + log-last-time + (message + "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 +3140,9 @@ 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) @@ -3149,14 +3171,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-execute-once-per-second + log-first-time + (message "Re-applying formulas to %d lines...done" cnt)))) + ;; back to initial position - (message "Re-applying formulas...done") + (org-table-execute-once-per-second + (when all log-first-time) + (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) [-- Attachment #3: 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-21 9:10 ` Nathaniel Flath @ 2014-11-21 23:30 ` Nicolas Goaziou 2014-12-01 6:02 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Nicolas Goaziou @ 2014-11-21 23:30 UTC (permalink / raw) To: Nathaniel Flath; +Cc: Michael Brand, org-mode List Nathaniel Flath <flat0103@gmail.com> writes: > OK, I think I fixed that. Thanks. I didn't verify it compiles, but your macro still looks suspicious. > +(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." > + `(let ((t1 ,t1)) > + (if t1 > + (let ((curtime (current-time))) > + (when (< 0 (nth 1 (time-subtract curtime t1))) > + (setq t1 curtime) > + ,@body)) > + ,@body))) You shouldn't splice BODY twice in your macro. Also, I don't get why you need to (setq t1 curtime). Do you need a macro at all for this task? ISTM you only need to display a message conditionally and update a time value. Regard, ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-11-21 23:30 ` Nicolas Goaziou @ 2014-12-01 6:02 ` Nathaniel Flath 2014-12-01 6:15 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-12-01 6:02 UTC (permalink / raw) To: Nathaniel Flath, Michael Brand, org-mode List [-- Attachment #1.1: Type: text/plain, Size: 1043 bytes --] Changed it to just a function - you are correct, for this purpose I don't need a macro. On Fri, Nov 21, 2014 at 6:30 PM, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote: > Nathaniel Flath <flat0103@gmail.com> writes: > > > OK, I think I fixed that. > > Thanks. > > I didn't verify it compiles, but your macro still looks suspicious. > > > +(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." > > + `(let ((t1 ,t1)) > > + (if t1 > > + (let ((curtime (current-time))) > > + (when (< 0 (nth 1 (time-subtract curtime t1))) > > + (setq t1 curtime) > > + ,@body)) > > + ,@body))) > > You shouldn't splice BODY twice in your macro. Also, I don't get why you > need to (setq t1 curtime). > > Do you need a macro at all for this task? ISTM you only need to display > a message conditionally and update a time value. > > > Regard, > [-- Attachment #1.2: Type: text/html, Size: 1604 bytes --] [-- Attachment #2: 0001-org-table.el-org-table-recalculate-is-quieter.patch --] [-- Type: application/octet-stream, Size: 4752 bytes --] From 6a3291cdd7f9e73ea306c1bcea14d758d3b1d8b8 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 | 47 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 9 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 2139d86..a5b5b2c 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)))) + (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) [-- Attachment #3: 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-12-01 6:02 ` Nathaniel Flath @ 2014-12-01 6:15 ` Nathaniel Flath 2014-12-05 23:57 ` Nicolas Goaziou 0 siblings, 1 reply; 34+ messages in thread From: Nathaniel Flath @ 2014-12-01 6:15 UTC (permalink / raw) To: Nathaniel Flath, Michael Brand, org-mode List [-- Attachment #1.1: Type: text/plain, Size: 1215 bytes --] Sorry, that was incorrect - real patches attached. On Mon, Dec 1, 2014 at 1:02 AM, Nathaniel Flath <flat0103@gmail.com> wrote: > Changed it to just a function - you are correct, for this purpose I don't > need a macro. > > On Fri, Nov 21, 2014 at 6:30 PM, Nicolas Goaziou <mail@nicolasgoaziou.fr> > wrote: > >> Nathaniel Flath <flat0103@gmail.com> writes: >> >> > OK, I think I fixed that. >> >> Thanks. >> >> I didn't verify it compiles, but your macro still looks suspicious. >> >> > +(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." >> > + `(let ((t1 ,t1)) >> > + (if t1 >> > + (let ((curtime (current-time))) >> > + (when (< 0 (nth 1 (time-subtract curtime t1))) >> > + (setq t1 curtime) >> > + ,@body)) >> > + ,@body))) >> >> You shouldn't splice BODY twice in your macro. Also, I don't get why you >> need to (setq t1 curtime). >> >> Do you need a macro at all for this task? ISTM you only need to display >> a message conditionally and update a time value. >> >> >> Regard, >> > > [-- Attachment #1.2: Type: text/html, Size: 2085 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: 4757 bytes --] From 8a377874e97c3b8ae92a9c33a03238daf77fe480 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 | 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-12-01 6:15 ` Nathaniel Flath @ 2014-12-05 23:57 ` Nicolas Goaziou 2014-12-08 7:35 ` Nathaniel Flath 0 siblings, 1 reply; 34+ messages in thread From: Nicolas Goaziou @ 2014-12-05 23:57 UTC (permalink / raw) To: Nathaniel Flath; +Cc: Michael Brand, org-mode List 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, ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 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 0 siblings, 2 replies; 34+ messages in thread From: Nathaniel Flath @ 2014-12-08 7:35 UTC (permalink / raw) To: Nathaniel Flath, Michael Brand, org-mode List [-- 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) ^ permalink raw reply related [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-12-08 7:35 ` Nathaniel Flath @ 2014-12-08 12:56 ` Michael Brand 2014-12-14 21:07 ` Nicolas Goaziou 1 sibling, 0 replies; 34+ messages in thread From: Michael Brand @ 2014-12-08 12:56 UTC (permalink / raw) To: Nathaniel Flath; +Cc: org-mode List Hi Nathaniel The macro did not set the time to nil, the current function does when t1 is nil but I think it must not. This led me to the following ideas, sorry for not thinking enough earlier: Why not change the macro's (setq ,t1 curtime) to a function's (set t1 curtime), still conditional as it was in the macro and call the function with "'log-*-time", quoted? Why not factor out the action from the function that would then only return whether any action has to be taken and in consequence also factor out the sometimes needed test for "all"? (when (or (not all) (org-once-per-second 'log-*-time)) (message [...])) The function would not have to test t1 for nil anymore. In my opinion this functionality should go into org-macs.el, hence omitting "-table-" in the function name. Michael ^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATH] Speedups to org-table-recalculate 2014-12-08 7:35 ` Nathaniel Flath 2014-12-08 12:56 ` Michael Brand @ 2014-12-14 21:07 ` Nicolas Goaziou 1 sibling, 0 replies; 34+ messages in thread From: Nicolas Goaziou @ 2014-12-14 21:07 UTC (permalink / raw) To: Nathaniel Flath; +Cc: Michael Brand, org-mode List Hello, Nathaniel Flath <flat0103@gmail.com> writes: > Fixed. Applied, with "TINYCHANGE" tag. Thank you. Regards, -- Nicolas Goaziou ^ permalink raw reply [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).