[PATCH] org-clock-sum: Rewrite function to improve performance

[Morgan Smith]

* lisp/org-clock.el(org-clock-sum): Rewrite function using
'org-element-map' to traverse the file instead of searching.
---

Hello!

I have a very big file with lots of clock entries and refreshing my clocktable
has become slow.  Using '(benchmark-elapse (org-ctrl-c-ctrl-c))' I saw that it
took 5.660532903 seconds to refresh it!  After this rewrite it only takes
3.384914703 seconds.  Not great, but better.

Thanks,

Morgan

 lisp/org-clock.el | 148 +++++++++++++++++-----------------------------
 1 file changed, 54 insertions(+), 94 deletions(-)

diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 264774032..148af864b 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -33,15 +33,10 @@
 
 (require 'cl-lib)
 (require 'org)
+(require 'org-element)
 
 (declare-function calendar-iso-to-absolute "cal-iso" (date))
 (declare-function notifications-notify "notifications" (&rest params))
-(declare-function org-element-property "org-element-ast" (property node))
-(declare-function org-element-contents-end "org-element" (node))
-(declare-function org-element-end "org-element" (node))
-(declare-function org-element-type "org-element-ast" (node &optional 
anonymous))
-(declare-function org-element-type-p "org-element-ast" (node types))
-(defvar org-element-use-cache)
 (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
@@ -1948,100 +1943,65 @@ each headline in the time range with point at the 
headline.  Headlines for
 which HEADLINE-FILTER returns nil are excluded from the clock summation.
 PROPNAME lets you set a custom text property instead of :org-clock-minutes."
   (with-silent-modifications
-    (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
-                      org-clock-string
-                      "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ 
\t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
-          (lmax 30)
-          (ltimes (make-vector lmax 0))
-          (level 0)
-          (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
+    (let* ((tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
                         ((consp tstart) (float-time tstart))
                         (t tstart)))
           (tend (cond ((stringp tend) (org-time-string-to-seconds tend))
                       ((consp tend) (float-time tend))
                       (t tend)))
-          (t1 0)
-          time)
+           (file-total 0))
       (remove-text-properties (point-min) (point-max)
-                             `(,(or propname :org-clock-minutes) t
-                               :org-clock-force-headline-inclusion t))
-      (save-excursion
-       (goto-char (point-max))
-       (while (re-search-backward re nil t)
-          (let* ((element (save-match-data (org-element-at-point)))
-                 (element-type (org-element-type element)))
-           (cond
-            ((and (eq element-type 'clock) (match-end 2))
-             ;; Two time stamps.
-             (let* ((timestamp (org-element-property :value element))
-                    (ts (float-time
-                          (org-encode-time
-                           (list 0
-                                 (org-element-property :minute-start timestamp)
-                                 (org-element-property :hour-start timestamp)
-                                 (org-element-property :day-start timestamp)
-                                 (org-element-property :month-start timestamp)
-                                 (org-element-property :year-start timestamp)
-                                 nil -1 nil))))
-                    (te (float-time
-                          (org-encode-time
-                           (list 0
-                                 (org-element-property :minute-end timestamp)
-                                 (org-element-property :hour-end timestamp)
-                                 (org-element-property :day-end timestamp)
-                                 (org-element-property :month-end timestamp)
-                                 (org-element-property :year-end timestamp)
-                                 nil -1 nil))))
-                    (dt (- (if tend (min te tend) te)
-                           (if tstart (max ts tstart) ts))))
-               (when (> dt 0) (cl-incf t1 (floor dt 60)))))
-            ((match-end 4)
-             ;; A naked time.
-             (setq t1 (+ t1 (string-to-number (match-string 5))
-                         (* 60 (string-to-number (match-string 4))))))
-            ((memq element-type '(headline inlinetask)) ;A headline
-             ;; Add the currently clocking item time to the total.
-             (when (and org-clock-report-include-clocking-task
-                        (eq (org-clocking-buffer) (current-buffer))
-                        (eq (marker-position org-clock-hd-marker) (point))
-                        tstart
-                        tend
-                        (>= (float-time org-clock-start-time) tstart)
-                        (<= (float-time org-clock-start-time) tend))
-               (let ((time (floor (org-time-convert-to-integer
-                                   (time-since org-clock-start-time))
-                                  60)))
-                 (setq t1 (+ t1 time))))
-             (let* ((headline-forced
-                     (get-text-property (point)
-                                        :org-clock-force-headline-inclusion))
-                    (headline-included
-                     (or (null headline-filter)
-                         (save-excursion
-                           (save-match-data (funcall headline-filter))))))
-               (setq level (- (match-end 1) (match-beginning 1)))
-               (when (>= level lmax)
-                 (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 
lmax)))
-               (when (or (> t1 0) (> (aref ltimes level) 0))
-                 (when (or headline-included headline-forced)
-                   (if headline-included
-                       (cl-loop for l from 0 to level do
-                                (aset ltimes l (+ (aref ltimes l) t1))))
-                   (setq time (aref ltimes level))
-                   (goto-char (match-beginning 0))
-                    (put-text-property (point) (line-end-position)
-                                      (or propname :org-clock-minutes) time)
-                   (when headline-filter
-                     (save-excursion
-                       (save-match-data
-                         (while (org-up-heading-safe)
-                           (put-text-property
-                            (point) (line-end-position)
-                            :org-clock-force-headline-inclusion t))))))
-                 (setq t1 0)
-                 (cl-loop for l from level to (1- lmax) do
-                          (aset ltimes l 0))))))))
-       (setq org-clock-file-total-minutes (aref ltimes 0))))))
+                              `(,(or propname :org-clock-minutes) t))
+      (org-element-map (org-element-parse-buffer 'element nil t) '(headline 
inlinetask)
+        (lambda (headline)
+          (when headline-filter
+            (unless
+                (save-excursion
+                  (org-element-map headline '(headline inlinetask)
+                    (lambda (child)
+                      (goto-char (org-element-begin child))
+                      (funcall headline-filter))))
+              (throw :org-element-skip nil)))
+          (let ((headline-total 0))
+            (org-element-map (org-element-contents headline) 'clock
+              (lambda (el)
+                (let (duration)
+                  (if
+                      (eq 'running (org-element-property :status el))
+                      (progn
+                        (when (and org-clock-report-include-clocking-task
+                                   (eq (org-clocking-buffer) (current-buffer))
+                                   (eq (marker-position org-clock-hd-marker)
+                                       (org-element-begin headline))
+                                   tstart
+                                   tend
+                                   (>= (float-time org-clock-start-time) 
tstart)
+                                   (<= (float-time org-clock-start-time) tend))
+                          (let ((time (floor (org-time-convert-to-integer
+                                              (time-since 
org-clock-start-time))
+                                             60)))
+                            (setq duration time))))
+                    (let* ((timestamp (org-element-property :value el))
+                           (ts (float-time (org-timestamp-to-time timestamp)))
+                           (te (float-time (org-timestamp-to-time timestamp 
t)))
+                           (dt (- (if tend (min te tend) te)
+                                  (if tstart (max ts tstart) ts))))
+                      (setq duration (floor dt 60))))
+                  (when (> duration 0)
+                    (setq headline-total (+ headline-total duration)))))
+              nil nil 'headline)
+            (put-text-property (org-element-begin headline) (1- 
(org-element-contents-begin headline))
+                               (or propname :org-clock-minutes) headline-total)
+            (org-element-lineage-map headline
+                (lambda (parent)
+                  (put-text-property (org-element-begin parent) (1- 
(org-element-contents-begin parent))
+                                     (or propname :org-clock-minutes)
+                                     (+ headline-total
+                                        (get-text-property (org-element-begin 
parent)
+                                                           (or propname 
:org-clock-minutes)))))
+              'headline)
+            (setq file-total (+ file-total headline-total)))))
+      (setq org-clock-file-total-minutes file-total))))
 
 (defun org-clock-sum-current-item (&optional tstart)
   "Return time, clocked on current item in total."
-- 
2.41.0