From: Morgan Smith <Morgan.J.Smith@outlook.com>
To: emacs-orgmode@gnu.org
Subject: [PATCH] org-clock-sum: Rewrite function to improve performance
Date: Wed, 19 Jul 2023 17:35:40 -0400 [thread overview]
Message-ID: <DM5PR03MB31630410C392C7B706E0488DC539A@DM5PR03MB3163.namprd03.prod.outlook.com> (raw)
* 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
next reply other threads:[~2023-07-19 21:43 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-19 21:35 Morgan Smith [this message]
2023-07-20 7:46 ` [PATCH] org-clock-sum: Rewrite function to improve performance Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=DM5PR03MB31630410C392C7B706E0488DC539A@DM5PR03MB3163.namprd03.prod.outlook.com \
--to=morgan.j.smith@outlook.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).