1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
--- 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)
|
