[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient
From: |
Adam Spiers |
Subject: |
[PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient |
Date: |
Mon, 19 Oct 2020 02:11:59 +0100 |
[This is only lightly tested and therefore probably not quite ready
for merging yet; however I'm submitting now to get feedback.]
org-entries-lessp was not as efficient a multi-criteria comparator as
it could have been, since it evaluated all criteria and then combined
them via (eval (cons 'or ...)), thereby missing a chance for lazy
evaluation via short-circuiting: if one of the earlier criteria in
org-agenda-sorting-strategy-selected evaluates to non-nil, giving a
definitive comparison result, there is no need to evaluate any of the
later criteria.
So instead iterate over the criteria one by one, and return as soon as
we have a definitive result.
Also remove code duplication by adopting a unified approach to
ascending/descending sorting.
Note that the way org-entries-lessp is invoked by
org-agenda-finalize-entries is still inefficient, because the same
values (e.g. timestamps, priorities, etc.) are extracted from every
pair of entries in each comparison within the sort. In the future,
introducing a Schwartzian transform can probably address this.
However the refactoring in this commit is a step in the right
direction, and it also allows other code to determine which comparison
is decisive in ordering any two elements.
Signed-off-by: Adam Spiers <orgmode@adamspiers.org>
---
lisp/org-agenda.el | 103 ++++++++++++++++++++-------------------------
1 file changed, 46 insertions(+), 57 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 88bb3f90d..eadc7fedd 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -7187,65 +7187,54 @@ (defsubst org-cmp-habit-p (a b)
(cond ((and ha (not hb)) -1)
((and (not ha) hb) +1))))
+(defun org-entries-cmp (a b)
+ "Iterate through the sorting criteria in
+`org-agenda-sorting-strategy-selected' until a sorter returns a
+definitive comparison, then return a cons cell (RESULT . SORTER)."
+ (let (sorted-by
+ sort-result
+ (ss org-agenda-sorting-strategy-selected))
+ (while (and ss (not sorted-by))
+ (let* ((sorter (car ss))
+ (sorter-name (symbol-name sorter))
+ ;; If sorter symbol ends in "-down" then pass the -up version
+ ;; to org-entries-cmp-1 and then negate the result.
+ (sorter-down-p (string-match "-down\\'" sorter-name))
+ (up-sorter
+ (if sorter-down-p
+ (replace-regexp-in-string "-down\\'" "-up" sorter-name)
+ sorter-name)))
+ (setq sort-result (org-entries-cmp-1 a b (intern up-sorter)))
+ (setq ss (cdr ss))
+ (when sort-result
+ (setq sort-result (if sorter-down-p (- sort-result) sort-result))
+ (setq sorted-by sorter))))
+ (cons sort-result sorted-by)))
+
+(defun org-entries-cmp-1 (a b sorter)
+ "Compare two entries via the given sorter."
+ (pcase sorter
+ ('timestamp-up (org-cmp-ts a b ""))
+ ('scheduled-up (org-cmp-ts a b "scheduled"))
+ ('deadline-up (org-cmp-ts a b "deadline"))
+ ('tsia-up (org-cmp-ts a b "timestamp_ia"))
+ ('ts-up (org-cmp-ts a b "timestamp"))
+ ('time-up (org-cmp-time a b))
+ ('stats-up (org-cmp-values a b 'org-stats))
+ ('priority-up (org-cmp-values a b 'priority))
+ ('effort-up (org-cmp-effort a b))
+ ('category-up (org-cmp-category a b))
+ ('category-keep (if (org-cmp-category a b) +1 nil)) ;; FIXME: check this
+ ('tag-up (org-cmp-tag a b))
+ ('todo-state-up (org-cmp-todo-state a b))
+ ('habit-up (org-cmp-habit-p a b))
+ ('alpha-up (org-cmp-alpha a b))
+ ('user-defined-up (funcall org-agenda-cmp-user-defined a b))))
+
(defun org-entries-lessp (a b)
"Predicate for sorting agenda entries."
- ;; The following variables will be used when the form is evaluated.
- ;; So even though the compiler complains, keep them.
- (let* ((ss org-agenda-sorting-strategy-selected)
- (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
- (org-cmp-ts a b "")))
- (timestamp-down (if timestamp-up (- timestamp-up) nil))
- (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
- (org-cmp-ts a b "scheduled")))
- (scheduled-down (if scheduled-up (- scheduled-up) nil))
- (deadline-up (and (org-em 'deadline-up 'deadline-down ss)
- (org-cmp-ts a b "deadline")))
- (deadline-down (if deadline-up (- deadline-up) nil))
- (tsia-up (and (org-em 'tsia-up 'tsia-down ss)
- (org-cmp-ts a b "timestamp_ia")))
- (tsia-down (if tsia-up (- tsia-up) nil))
- (ts-up (and (org-em 'ts-up 'ts-down ss)
- (org-cmp-ts a b "timestamp")))
- (ts-down (if ts-up (- ts-up) nil))
- (time-up (and (org-em 'time-up 'time-down ss)
- (org-cmp-time a b)))
- (time-down (if time-up (- time-up) nil))
- (stats-up (and (org-em 'stats-up 'stats-down ss)
- (org-cmp-values a b 'org-stats)))
- (stats-down (if stats-up (- stats-up) nil))
- (priority-up (and (org-em 'priority-up 'priority-down ss)
- (org-cmp-values a b 'priority)))
- (priority-down (if priority-up (- priority-up) nil))
- (effort-up (and (org-em 'effort-up 'effort-down ss)
- (org-cmp-effort a b)))
- (effort-down (if effort-up (- effort-up) nil))
- (category-up (and (or (org-em 'category-up 'category-down ss)
- (memq 'category-keep ss))
- (org-cmp-category a b)))
- (category-down (if category-up (- category-up) nil))
- (category-keep (if category-up +1 nil))
- (tag-up (and (org-em 'tag-up 'tag-down ss)
- (org-cmp-tag a b)))
- (tag-down (if tag-up (- tag-up) nil))
- (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss)
- (org-cmp-todo-state a b)))
- (todo-state-down (if todo-state-up (- todo-state-up) nil))
- (habit-up (and (org-em 'habit-up 'habit-down ss)
- (org-cmp-habit-p a b)))
- (habit-down (if habit-up (- habit-up) nil))
- (alpha-up (and (org-em 'alpha-up 'alpha-down ss)
- (org-cmp-alpha a b)))
- (alpha-down (if alpha-up (- alpha-up) nil))
- (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
- user-defined-up user-defined-down)
- (when (and need-user-cmp org-agenda-cmp-user-defined
- (functionp org-agenda-cmp-user-defined))
- (setq user-defined-up
- (funcall org-agenda-cmp-user-defined a b)
- user-defined-down (if user-defined-up (- user-defined-up) nil)))
- (cdr (assoc
- (eval (cons 'or org-agenda-sorting-strategy-selected))
- '((-1 . t) (1 . nil) (nil . nil))))))
+ (let ((sort-result (car (org-entries-cmp a b))))
+ (cdr (assoc sort-result '((-1 . t) (1 . nil) (nil . nil))))))
;;; Agenda restriction lock
--
2.28.0
- [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient,
Adam Spiers <=