From 6634107b0e46ddf90932178ecab13f6bbf854239 Mon Sep 17 00:00:00 2001
From: Carsten Dominik <carsten.dominik@gmail.com>
Date: Tue, 6 May 2008 12:46:51 +0200
Subject: [PATCH] Apply patch from Thomas Baumann, to use a hash for
 anniversaries.

This should speed up the agenda significantly when using BBDB
as the database for anniversaries.
---
 lisp/org-bbdb.el | 103 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 70 insertions(+), 33 deletions(-)

diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
index 1083cc438..1144faf4e 100644
--- a/lisp/org-bbdb.el
+++ b/lisp/org-bbdb.el
@@ -102,7 +102,7 @@
 (declare-function calendar-leap-year-p "calendar" (year))
 (declare-function diary-ordinal-suffix "diary-lib" (n))
 
-(defvar date)
+(defvar date)   ;; dynamically scoped from Org
 
 ;; Customization
 
@@ -230,17 +230,19 @@ Argument STR is the anniversary field in BBDB."
 		  (bbdb-string-trim (substring str pos)))
       (list str nil))))
 
+(defvar org-bbdb-anniv-hash nil
+  "A hash holding anniversaries extracted from BBDB.
+The hash table is created on first use.")
 
-;;;###autoload
-(defun org-bbdb-anniversaries ()
-  "Extract anniversaries from BBDB for display in the agenda."
-  (require 'diary-lib)
-  (let ((dates (list (cons (cons (car date)    ; month
-                                 (nth 1 date)) ; day
-                           (nth 2 date))))     ; year
-        (text ())
-        annivs date years
-        split class form)
+(defvar org-bbdb-updated-p t
+  "This is non-nil if BBDB has been updated since we last built the hash.")
+
+(defun org-bbdb-make-anniv-hash ()
+  "Create a hash with anniversaries extracted from BBDB, for fast access.
+The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
+
+  (let (split tmp annivs)
+    (clrhash org-bbdb-anniv-hash)
     (dolist (rec (bbdb-records))
       (when (setq annivs (bbdb-record-getprop
                           rec org-bbdb-anniversary-field))
@@ -249,29 +251,64 @@ Argument STR is the anniversary field in BBDB."
           (setq split (org-bbdb-anniv-split (pop annivs)))
           (multiple-value-bind (m d y)
               (funcall org-bbdb-extract-date-fun (car split))
+            (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
+            (puthash (list m d) (cons (list y 
+                                            (bbdb-record-name rec) 
+                                            (cadr split))
+                                      tmp)
+                     org-bbdb-anniv-hash))))))
+  (setq org-bbdb-updated-p nil))
 
-            (when (and (or (setq date (assoc (cons m d) dates))
-                           (and (= d 29)
-                                (= m 2)
-                                (setq date (assoc '(3 . 1) dates))
-                                (not (calendar-leap-year-p (cdr date)))))
-                       (< 0 (setq years (-  (cdr date) y))))
-              (let* ((class (or (cadr split)
-                                org-bbdb-default-anniversary-format))
-                     (form (or (cdr (assoc class
-                                           org-bbdb-anniversary-format-alist))
-                               class))	; (as format string)
-                     (name (bbdb-record-name rec))
-                     (suffix (diary-ordinal-suffix years))
-                     (tmp (cond
-                           ((functionp form)
-                            (funcall form name years suffix))
-                           ((listp form) (eval form))
-                           (t (format form name years suffix)))))
-                (if text
-                    (setq text (append text (list tmp)))
-                  (setq text (list tmp))))
-              )))))
+(defun org-bbdb-updated (rec)
+  "Record the fact that BBDB has been updated.
+This is used by Org to re-create the anniversary hash table."
+  (setq org-bbdb-updated-p t))
+
+(add-hook 'bbdb-after-change-hook 'org-bbdb-updated)
+
+;;;###autoload
+(defun org-bbdb-anniversaries()
+  "Extract anniversaries from BBDB for display in the agenda."
+  (require 'diary-lib)
+  (unless (hash-table-p org-bbdb-anniv-hash)
+    (setq org-bbdb-anniv-hash
+	  (make-hash-table :test 'equal :size 366)))
+
+  (when (or org-bbdb-updated-p
+            (= 0 (hash-table-count org-bbdb-anniv-hash)))
+    (org-bbdb-make-anniv-hash))
+
+  (let* ((m (car date))    ; month
+         (d (nth 1 date))  ; day
+         (y (nth 2 date))  ; year
+         (annivs (gethash (list m d) org-bbdb-anniv-hash))
+         (text ())
+         split class form rec)
+    
+    ;; we don't want to miss people born on Feb. 29th
+    (when (and (= m 3) (= d 1) (not (calendar-leap-year-p y)))
+      (setq annivs (cons annivs (gethash (list 2 29) org-bbdb-anniv-hash))))
+
+    (when annivs
+      (while (setq rec (pop annivs))
+        (when rec 
+          (let* ((class (or (nth 2 rec)
+                            org-bbdb-default-anniversary-format))
+                 (form (or (cdr (assoc class
+                                       org-bbdb-anniversary-format-alist))
+                           class))	; (as format string)
+                 (name (nth 1 rec))
+                 (years (- y (car rec)))
+                 (suffix (diary-ordinal-suffix years))
+                 (tmp (cond
+                       ((functionp form)
+                        (funcall form name years suffix))
+                       ((listp form) (eval form))
+                       (t (format form name years suffix)))))
+            (if text
+                (setq text (append text (list tmp)))
+              (setq text (list tmp)))))
+        ))
     (when text
       (mapconcat 'identity text "; "))))
 
-- 
2.11.4.GIT