emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] org-clock-sum: Rewrite function to improve performance
@ 2023-07-19 21:35 Morgan Smith
  2023-07-20  7:46 ` Ihor Radchenko
  0 siblings, 1 reply; 2+ messages in thread
From: Morgan Smith @ 2023-07-19 21:35 UTC (permalink / raw)
  To: emacs-orgmode

* 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



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

end of thread, other threads:[~2023-07-20  7:47 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-07-19 21:35 [PATCH] org-clock-sum: Rewrite function to improve performance Morgan Smith
2023-07-20  7:46 ` Ihor Radchenko

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