From 6370302498213bd29b3b5411de1e21a26d027452 Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 22 Apr 2002 05:53:29 +0000 Subject: [PATCH] * gnus-vers.el (gnus-revision-number): Increment to 03. * gnus-bbdb.el (gnus-bbdb/update-record): Tweak BBDB message caching. (gnus-bbdb/extract-message-sender-function): New user option. (gnus-bbdb/extract-message-sender): New function. --- lisp/gnus-bbdb.el | 57 +++++++++++++++++++++++++++++++++-------------------- lisp/gnus-vers.el | 2 +- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el index d8d6960..7a18625 100644 --- a/lisp/gnus-bbdb.el +++ b/lisp/gnus-bbdb.el @@ -46,34 +46,48 @@ ,field-body ,field-name)) ,field-body)) +(defvar gnus-bbdb/extract-message-sender-function + 'gnus-bbdb/extract-message-sender) + +(defun gnus-bbdb/extract-message-sender () + (let ((from (mail-header-from gnus-current-headers)) + to) + (when from + (setq from (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body from 'From))) + (if (and (car (cdr from)) + (string-match (bbdb-user-mail-names) (car (cdr from))) + ;; if logged-in user sent this, use recipients. + (setq to (mime-entity-fetch-field gnus-current-headers "to"))) + (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body to 'To)) + from)))) + ;;;###autoload (defun gnus-bbdb/update-record (&optional offer-to-create) - "returns the record corresponding to the current GNUS message, creating + "Return the record corresponding to the current GNUS message, creating or modifying it as necessary. A record will be created if bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and the user confirms the creation." (if bbdb-use-pop-up (gnus-bbdb/pop-up-bbdb-buffer offer-to-create) - (let ((from (mime-entity-fetch-field gnus-current-headers "from"))) - (when from - (setq from (gnus-bbdb/extract-address-components - (gnus-bbdb/decode-field-body from 'From)))) - (when (and (car (cdr from)) - (string-match (bbdb-user-mail-names) - (car (cdr from)))) - ;; if logged-in user sent this, use recipients. - (let ((to (mime-entity-fetch-field gnus-current-headers "to"))) - (when to - (setq from - (gnus-bbdb/extract-address-components - (gnus-bbdb/decode-field-body to 'To)))))) - (when from - (save-excursion - (bbdb-annotate-message-sender from t - (or (bbdb-invoke-hook-for-value - bbdb/news-auto-create-p) - offer-to-create) - offer-to-create)))))) + (let ((message-key + (intern (mail-header-id gnus-current-headers))) + record sender) + (or (and (setq record (bbdb-message-cache-lookup message-key)) + (if (listp record) + (nth 1 record) + record)) + (when (setq sender + (funcall gnus-bbdb/extract-message-sender-function)) + (save-excursion + (bbdb-encache-message + message-key + (bbdb-annotate-message-sender sender t + (or (bbdb-invoke-hook-for-value + bbdb/news-auto-create-p) + offer-to-create) + offer-to-create)))))))) ;;;###autoload (defun gnus-bbdb/annotate-sender (string &optional replace) @@ -601,6 +615,7 @@ beginning of the message headers." (add-to-list 'bbdb-extract-field-value-function-list 'gnus-bbdb/extract-field-value-init)) (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record) + (add-hook 'gnus-summary-exit-hook 'bbdb-flush-all-caches) (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save) (define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender) (define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes) diff --git a/lisp/gnus-vers.el b/lisp/gnus-vers.el index bac3f77..3cd358b 100644 --- a/lisp/gnus-vers.el +++ b/lisp/gnus-vers.el @@ -34,7 +34,7 @@ (require 'product) (provide 'gnus-vers) -(defconst gnus-revision-number "02" +(defconst gnus-revision-number "03" "Revision number for this version of gnus.") ;; Product information of this gnus. -- 1.7.10.4