From 7f085d0e5c4c85f94d11c4aaa90555d4da4cfca1 Mon Sep 17 00:00:00 2001
From: Carsten Dominik <carsten.dominik@gmail.com>
Date: Fri, 30 Apr 2010 07:49:59 +0200
Subject: [PATCH] Agenda: Speed-up comparing entries when sorting

The comparison function now only computes the comparisons actually needed.
---
 lisp/ChangeLog     |  2 ++
 lisp/org-agenda.el | 44 ++++++++++++++++++++++++++++----------------
 2 files changed, 30 insertions(+), 16 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1ee199233..aa8d0232f 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,8 @@
 
 	* org-agenda.el (org-sorting-choice): New sorting type alpha.
 	(org-cmp-alpha): New defsubst.
+	(org-em): New defsubst.
+	(org-entries-lessp): Only compute needed comparisons.
 
 2010-04-29  Carsten Dominik  <carsten.dominik@gmail.com>
 
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 984752935..2b56cb65a 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -5260,27 +5260,39 @@ HH:MM."
 	  ((and (not ha) hb) +1)
 	  (t nil))))
 
+(defsubst org-em (x y list) (or (memq x list) (memq y list)))
+
 (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* ((time-up (org-cmp-time a b))
-	 (time-down (if time-up (- time-up) nil))
-	 (priority-up (org-cmp-priority a b))
-	 (priority-down (if priority-up (- priority-up) nil))
-	 (effort-up (org-cmp-effort a b))
-	 (effort-down (if effort-up (- effort-up) nil))
-	 (category-up (org-cmp-category a b))
-	 (category-down (if category-up (- category-up) nil))
-	 (category-keep (if category-up +1 nil))
-	 (tag-up (org-cmp-tag a b))
-	 (tag-down (if tag-up (- tag-up) nil))
-	 (todo-state-up (org-cmp-todo-state a b))
+  (let* ((ss org-agenda-sorting-strategy-selected)
+	 (time-up         (and (org-em 'time-up 'time-down ss)
+			       (org-cmp-time a b)))
+	 (time-down       (if time-up (- time-up) nil))
+	 (priority-up     (and (org-em 'priority-up 'priority-down ss)
+			       (org-cmp-priority a b)))
+	 (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 (org-cmp-habit-p a b))
-	 (habit-down (if habit-up (- habit-up) nil))
-	 (alpha-up (org-cmp-alpha a b))
-	 (alpha-down (if alpha-up (- alpha-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))
 	 user-defined-up user-defined-down)
     (if (and org-agenda-cmp-user-defined
 	     (functionp org-agenda-cmp-user-defined))
-- 
2.11.4.GIT