[elpa] externals/org-contacts d630e91dee 033/154: Add caching mecanism

[ELPA Syncer]

branch: externals/org-contacts
commit d630e91dee767c991ffb984ddd72d1f2d3b3f93b
Author: Grégoire Jadi <gregoire.jadi@gmail.com>
Commit: Grégoire Jadi <gregoire.jadi@gmail.com>

    Add caching mecanism
    
    * contrib/lisp/org-contacts.el: Add a caching mecanism around
      `org-contacts-filter'.
---
 org-contacts.el | 74 ++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 50 insertions(+), 24 deletions(-)

diff --git a/org-contacts.el b/org-contacts.el
index 49bf4894d3..7af8c356a4 100644
--- a/org-contacts.el
+++ b/org-contacts.el
@@ -139,38 +139,64 @@ This overrides `org-email-link-description-format' if 
set."
     map)
   "The keymap used in `org-contacts' result list.")
 
+(defvar org-contacts-db nil
+  "Org Contacts database.")
+
+(defvar org-contacts-last-update nil
+  "Last time the Org Contacts database has been updated.")
+
 (defun org-contacts-files ()
   "Return list of Org files to use for contact management."
   (or org-contacts-files (org-agenda-files t 'ifmode)))
 
-(defun org-contacts-filter (&optional name-match tags-match)
-  "Search for a contact maching NAME-MATCH and TAGS-MATCH.
-If both match values are nil, return all contacts."
+(defun org-contacts-db ()
+  "Return the latest Org Contacts Database"
   (let* (todo-only
-        (tags-matcher
-         (if tags-match
-             (cdr (org-make-tags-matcher tags-match))
-           t))
-        (name-matcher
-         (if name-match
-             '(org-string-match-p name-match (org-get-heading t))
-           t))
         (contacts-matcher
          (cdr (org-make-tags-matcher org-contacts-matcher)))
+        (need-update?
+         (or (null org-contacts-last-update)
+             (some (lambda (file)
+                     (time-less-p org-contacts-last-update
+                                  (elt (file-attributes file) 5)))
+                   (org-contacts-files))))
         markers result)
-    (dolist (file (org-contacts-files))
-      (org-check-agenda-file file)
-      (with-current-buffer (org-get-agenda-file-buffer file)
-        (unless (eq major-mode 'org-mode)
-          (error "File %s is no in `org-mode'" file))
-        (org-scan-tags
-         '(add-to-list 'markers (set-marker (make-marker) (point)))
-         `(and ,contacts-matcher ,tags-matcher ,name-matcher)
-        todo-only)))
-    (dolist (marker markers result)
-      (org-with-point-at marker
-        (add-to-list 'result
-                     (list (org-get-heading t) marker (org-entry-properties 
marker 'all)))))))
+    (when need-update?
+      (message "Update Org Contacts Database")
+      (dolist (file (org-contacts-files))
+       (org-check-agenda-file file)
+       (with-current-buffer (org-get-agenda-file-buffer file)
+         (unless (eq major-mode 'org-mode)
+           (error "File %s is no in `org-mode'" file))
+         (org-scan-tags
+          '(add-to-list 'markers (set-marker (make-marker) (point)))
+          contacts-matcher
+          todo-only)))
+      (dolist (marker markers result)
+       (org-with-point-at marker
+         (add-to-list 'result
+                      (list (org-get-heading t) marker (org-entry-properties 
marker 'all)))))
+      (setf org-contacts-db result
+           org-contacts-last-update (current-time)))
+    org-contacts-db))
+
+(defun org-contacts-filter (&optional name-match tags-match)
+  "Search for a contact maching NAME-MATCH and TAGS-MATCH.
+If both match values are nil, return all contacts."
+  (if (and (null name-match)
+          (null tags-match))
+      (org-contacts-db)
+    (loop for contact in (org-contacts-db)
+         if (or
+             (and name-match
+                  (org-string-match-p name-match
+                                      (first contact)))
+             (and tags-match
+                  (some (lambda (tag)
+                          (org-string-match-p tags-match tag))
+                        (org-split-string
+                         (or (cdr (assoc-string "ALLTAGS" (caddr contact))) 
"") ":"))))
+         collect contact)))
 
 (when (not (fboundp 'completion-table-case-fold))
   ;; That function is new in Emacs 24...