--- cmail/bbdb-cmail.el Sat Apr 20 23:37:47 2002 +++ bbdb-cmail.el Sun Apr 21 00:27:26 2002 @@ -43,6 +43,11 @@ (require 'bbdb) +(require 'bbdb-snarf) (require 'cmail) +(eval-and-compile + (require 'bbdb-com) + (require 'rfc822)) + (defvar bbdb/cmail-buffer "*BBDB-cmail*") @@ -63,28 +68,57 @@ more details." t nil) +(defvar bbdb/cmail-update-records-mode 'annotating + "Controls how `bbdb/cmail-update-records' processes email addresses. +Set this to an expression which evaluates either to 'searching or +'annotating. When set to 'annotating email addresses will be fed to +`bbdb-annotate-message-sender' in order to update existing records or create +new ones. A value of 'searching will search just for existing records having +the right net. + +annotating = annotating all messages +searching = annotating no messages") + (defun bbdb/cmail-update-record (&optional offer-to-create) - "Returns the record corresponding to the current cmail message, -creating or modifying it as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." - (if bbdb-use-pop-up - (bbdb/cmail-pop-up-bbdb-buffer offer-to-create) + (let* ((bbdb-get-only-first-address-p t) + (records (bbdb/cmail-update-records offer-to-create))) + (if records (car records) nil))) + +(defun bbdb/cmail-update-records (&optional offer-to-create) + "Return the records corresponding to the current cmail message, creating +or modifying it as necessary. A record will be created if +bbdb/mail-auto-create-p is non-nil or if OFFER-TO-CREATE is true +and the user confirms the creation. + +The variable `bbdb/cmail-update-records-mode' controls what actions +are performed and it might override `bbdb-update-records-mode'. + +When hitting C-g once you will not be asked anymore for new people listed +in this message, but it will search only for existing records. When hitting +C-g again it will stop scanning." + (let ((bbdb/cmail-offer-to-create offer-to-create) + msg-id records cache) (save-excursion - (let (from addr (inhibit-read-only t)) - (bbdb/cmail-open-header) - (setq from (mail-fetch-field "From")) - (if from - (setq addr (car (cdr (mail-extract-address-components from))))) - (if (or (null from) - (null addr) - (string-match (bbdb-user-mail-names) addr)) - (setq from (or (mail-fetch-field "To") - from))) - (if from - (bbdb-annotate-message-sender from t - (or (bbdb-invoke-hook-for-value - bbdb/mail-auto-create-p) - offer-to-create) - offer-to-create)))))) + (bbdb/cmail-open-header) + (setq msg-id (mail-fetch-field "Message-ID")) + (if (and msg-id (not bbdb/cmail-offer-to-create)) + (setq cache (bbdb-message-cache-lookup msg-id))) + + (if cache + (setq records (if bbdb-get-only-first-address-p + (list (car cache)) + cache)) + + (let ((bbdb-update-records-mode (or bbdb/cmail-update-records-mode + bbdb-update-records-mode))) + (setq records (bbdb-update-records + (bbdb-get-addresses + bbdb-get-only-first-address-p + bbdb-user-mail-names + 'mail-fetch-field) + bbdb/mail-auto-create-p + offer-to-create))) + (if (and bbdb-message-caching-enabled msg-id) + (bbdb-encache-message msg-id records)))) + records)) (defun bbdb/cmail-annotate-sender (string &optional replace) @@ -107,40 +141,68 @@ (bbdb-record-edit-notes record t)))) -(defun bbdb/cmail-show-sender () - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." +(defun bbdb/cmail-show-records (&optional address-class) + "Display the contents of the BBDB for all addresses of this message. +This buffer will be in `bbdb-mode', with associated keybindings." (interactive) - (let ((record (bbdb/cmail-update-record t))) - (if record - (bbdb-display-records (list record)) - (error "unperson")))) + (cmail-select-buffer *cmail-summary-buffer) + (let ((bbdb-get-addresses-headers + (if address-class + (list (assoc address-class bbdb-get-addresses-headers)) + bbdb-get-addresses-headers)) + (bbdb/cmail-update-records-mode 'annotating) + (bbdb-message-cache nil) + (bbdb-user-mail-names nil) + records) + (setq records (bbdb/cmail-update-records t)) + (if records + (bbdb-display-records records) + (bbdb-undisplay-records)) + records)) + +(defun bbdb/cmail-show-all-recipients () + "Show all recipients of this message. +Counterpart to `bbdb/cmail-show-sender'." + (interactive) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/cmail-show-records 'recipients))) + +(defun bbdb/cmail-show-sender (&optional show-recipients) + "Display the contents of the BBDB for the senders of this message. +With a prefix argument show the recipients instead, +with two prefix arguments show all records. +This buffer will be in `bbdb-mode', with associated keybindings." + (interactive "p") + (cond ((= 4 show-recipients) + (bbdb/cmail-show-all-recipients)) + ((= 16 show-recipients) + (let ((bbdb-get-only-first-address-p nil)) + (bbdb/cmail-show-records))) + (t + (if (null (bbdb/cmail-show-records 'authors)) + (bbdb/cmail-show-all-recipients))))) (defun bbdb/cmail-pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the cmail windows, -displaying the record corresponding to the sender of the current message." - (let ((framepop (eq temp-buffer-show-function 'framepop-display-buffer))) - (or framepop - (bbdb-pop-up-bbdb-buffer - (function - (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'cmail-readmail-mode) - (set-buffer b))))))) + (save-excursion (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((record (bbdb/cmail-update-record offer-to-create)) - (bbdb-elided-display (bbdb-pop-up-elided-display)) - (b (current-buffer))) - (if framepop - (if record - (bbdb-display-records (list record)) - (framepop-banish)) - (if record - (bbdb-display-records (list record)) - (delete-window (get-buffer-window bbdb-buffer-name)))) - (set-buffer b) - record)))) + (bbdb-electric-p nil) + (records (bbdb/cmail-update-records offer-to-create)) + (bbdb-buffer-name bbdb-buffer-name)) + + (when (and bbdb-use-pop-up records) + (bbdb-pop-up-bbdb-buffer + (function (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (eq major-mode 'cmail-readmail-mode) + (set-buffer b)))))) + + ;; Always update the records; if there are no records, empty the + ;; BBDB window. This should be generic, not cmail-specific. + (bbdb-display-records records bbdb-pop-up-display-layout)) + + (when (not records) + (bbdb-undisplay-records) + (if (get-buffer-window bbdb-buffer-name) + (delete-window (get-buffer-window bbdb-buffer-name))))))) (defun bbdb/cmail-open-header () @@ -155,16 +217,5 @@ (insert-buffer-substring (cmail-folder-buffer cmail-current-folder) beg end) - (goto-char (point-min)) - (bbdb/cmail-mode))) - -(defun bbdb/cmail-mode () - "Major mode for parsing header fields in BBDB." - (interactive) - (kill-all-local-variables) - (setq major-mode 'bbdb/cmail-mode) - (setq mode-name "BBDB-cmail") - (run-hooks 'bbdb/cmail-mode-hook) - (set-buffer-modified-p nil) - (setq buffer-read-only t)) + (goto-char (point-min)))) (defun bbdb/cmail-quit () @@ -175,5 +226,5 @@ (defun bbdb-insinuate-cmail () "Call this function to hook BBDB into cmail." - (add-hook 'cmail-show-contents-after-hook 'bbdb/cmail-update-record 'append) + (add-hook 'cmail-show-contents-after-hook 'bbdb/cmail-pop-up-bbdb-buffer 'append) (add-hook 'cmail-quit-hook 'bbdb/cmail-quit) (define-key cmail-summary-mode-map ":" 'bbdb/cmail-show-sender)