فهرست منبع

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.
Carsten Dominik 17 سال پیش
والد
کامیت
6634107b0e
1فایلهای تغییر یافته به همراه70 افزوده شده و 33 حذف شده
  1. 70 33
      lisp/org-bbdb.el

+ 70 - 33
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 "; "))))