Add caching mecanism

* contrib/lisp/org-contacts.el: Add a caching mecanism around
  `org-contacts-filter'.
This commit is contained in:
Grégoire Jadi 2013-02-14 17:35:29 +01:00
parent fb87d0eac0
commit d630e91dee

View file

@ -139,38 +139,64 @@ This overrides `org-email-link-description-format' if set."
map) map)
"The keymap used in `org-contacts' result list.") "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 () (defun org-contacts-files ()
"Return list of Org files to use for contact management." "Return list of Org files to use for contact management."
(or org-contacts-files (org-agenda-files t 'ifmode))) (or org-contacts-files (org-agenda-files t 'ifmode)))
(defun org-contacts-db ()
"Return the latest Org Contacts Database"
(let* (todo-only
(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)
(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) (defun org-contacts-filter (&optional name-match tags-match)
"Search for a contact maching NAME-MATCH and TAGS-MATCH. "Search for a contact maching NAME-MATCH and TAGS-MATCH.
If both match values are nil, return all contacts." If both match values are nil, return all contacts."
(let* (todo-only (if (and (null name-match)
(tags-matcher (null tags-match))
(if tags-match (org-contacts-db)
(cdr (org-make-tags-matcher tags-match)) (loop for contact in (org-contacts-db)
t)) if (or
(name-matcher (and name-match
(if name-match (org-string-match-p name-match
'(org-string-match-p name-match (org-get-heading t)) (first contact)))
t)) (and tags-match
(contacts-matcher (some (lambda (tag)
(cdr (org-make-tags-matcher org-contacts-matcher))) (org-string-match-p tags-match tag))
markers result) (org-split-string
(dolist (file (org-contacts-files)) (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
(org-check-agenda-file file) collect contact)))
(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 (not (fboundp 'completion-table-case-fold)) (when (not (fboundp 'completion-table-case-fold))
;; That function is new in Emacs 24... ;; That function is new in Emacs 24...