1 ;;; bbdb-wl.el -- BBDB interface to Wanderlust
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, news, database
10 ;; Insert the following lines in your ~/.wl
28 (defvar bbdb-pop-up-elided-display nil)
29 (or (fboundp 'bbdb-extract-field-value-internal)
30 (defun bbdb-extract-field-value-internal (field))))
32 (defvar bbdb-wl-get-update-record-hook nil)
34 (defun bbdb-wl-setup ()
36 (add-hook 'wl-message-redisplay-hook 'bbdb-wl-get-update-record)
37 (add-hook 'wl-summary-exit-hook 'bbdb-wl-hide-bbdb-buffer)
38 (add-hook 'wl-message-window-deleted-hook 'bbdb-wl-hide-bbdb-buffer)
39 (add-hook 'wl-exit-hook 'bbdb-wl-exit)
40 (add-hook 'wl-summary-toggle-disp-off-hook 'bbdb-wl-hide-bbdb-buffer)
41 (add-hook 'wl-summary-toggle-disp-folder-on-hook 'bbdb-wl-hide-bbdb-buffer)
42 (add-hook 'wl-summary-toggle-disp-folder-off-hook 'bbdb-wl-hide-bbdb-buffer)
43 (add-hook 'wl-summary-toggle-disp-folder-message-resumed-hook
44 'bbdb-wl-show-bbdb-buffer)
45 (add-hook 'wl-summary-mode-hook
48 (define-key (current-local-map) ":" 'bbdb-wl-show-sender)
49 (define-key (current-local-map) ";" 'bbdb-wl-edit-notes))))
50 (add-hook 'wl-summary-exit-hook 'bbdb-flush-all-caches)
51 (add-hook 'wl-summary-exec-hook 'bbdb-flush-all-caches)
52 (add-hook 'wl-mail-setup-hook
55 ;;; (local-set-key "\M-\t" 'bbdb-complete-name)
56 (define-key (current-local-map) "\M-\t" 'bbdb-complete-name)
59 (defun bbdb-wl-exit ()
61 (if (setq bbdb-buf (get-buffer bbdb-buffer-name))
62 (kill-buffer bbdb-buf)))
65 (defun bbdb-wl-get-update-record ()
66 (set-buffer (wl-message-get-original-buffer))
67 (bbdb-wl-update-record)
68 (run-hooks 'bbdb-wl-get-update-record-hook))
70 (defun bbdb-wl-hide-bbdb-buffer ()
71 (let (bbdb-buf bbdb-win)
72 (if (setq bbdb-buf (get-buffer bbdb-buffer-name))
73 (if (setq bbdb-win (get-buffer-window bbdb-buf))
74 (delete-window bbdb-win)))))
76 (defun bbdb-wl-show-bbdb-buffer ()
78 (if (get-buffer-window bbdb-buffer-name)
80 (let ((mes-win (get-buffer-window
82 (if (buffer-live-p wl-current-summary-buffer)
83 (set-buffer wl-current-summary-buffer))
84 wl-message-buf-name)))
85 (cur-win (selected-window))
87 (and mes-win (select-window mes-win))
89 (- (window-height mes-win)
91 (- (window-height mes-win)
92 (max window-min-height
93 (1+ bbdb-pop-up-target-lines))))))
94 (split-window mes-win (if (> size 0) size window-min-height)))
95 ;; goto the bottom of the two...
96 (select-window (next-window))
97 ;; make it display *BBDB*...
98 (let ((pop-up-windows nil))
99 (switch-to-buffer (get-buffer-create bbdb-buffer-name)))))))
101 (defun bbdb-wl-from-func (string)
102 "A candidate From field STRING. For `wl-summary-from-func'."
103 (let ((hit (bbdb-search-simple nil (wl-address-header-extract-address
105 first-name last-name from-str)
108 (setq first-name (aref hit 0))
109 (setq last-name (aref hit 1))
110 (cond ((and (null first-name)
112 (setq from-str string))
113 ((and first-name last-name)
114 (setq from-str (concat first-name " " last-name)))
115 ((or first-name last-name)
116 (setq from-str (or first-name last-name))))
120 (defun bbdb-wl-update-record (&optional offer-to-create)
121 "Returns the record corresponding to the current WL message,
122 creating or modifying it as necessary. A record will be created if
123 bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and
124 the user confirms the creation."
127 (bbdb-wl-pop-up-bbdb-buffer offer-to-create)
132 (if (buffer-live-p wl-current-summary-buffer)
133 (set-buffer wl-current-summary-buffer))
134 wl-message-buf-name))
137 wl-current-summary-buffer
138 wl-message-buffer-cur-number)))))
139 (or (bbdb-message-cache-lookup key nil)
141 (let* ((from (or (std11-field-body "From") ""))
143 (nth 1 (std11-extract-address-components
147 (string-match (bbdb-user-mail-names) addr))
148 (setq from (or (std11-field-body "To") from)))
149 (with-temp-buffer ; to keep raw buffer unibyte.
150 (elmo-set-buffer-multibyte
151 default-enable-multibyte-characters)
152 (setq from (eword-decode-string
153 (decode-mime-charset-string
157 (bbdb-encache-message
159 (bbdb-annotate-message-sender
161 (or (bbdb-invoke-hook-for-value
162 bbdb/mail-auto-create-p)
164 offer-to-create))))))))))
166 (defun bbdb-wl-annotate-sender (string)
167 "Add a line to the end of the Notes field of the BBDB record
168 corresponding to the sender of this message."
169 (interactive (list (if bbdb-readonly-p
170 (error "The Insidious Big Brother Database is read-only")
171 (read-string "Comments: "))))
172 (set-buffer (wl-message-get-original-buffer))
173 (bbdb-annotate-notes (bbdb-wl-update-record t) string))
175 (defun bbdb-wl-edit-notes (&optional arg)
176 "Edit the notes field or (with a prefix arg) a user-defined field
177 of the BBDB record corresponding to the sender of this message."
179 (wl-summary-redisplay)
180 (set-buffer (wl-message-get-original-buffer))
181 (let ((record (or (bbdb-wl-update-record t) (error ""))))
182 (bbdb-display-records (list record))
184 (bbdb-record-edit-property record nil t)
185 (bbdb-record-edit-notes record t))))
187 (defun bbdb-wl-show-sender ()
188 "Display the contents of the BBDB for the sender of this message.
189 This buffer will be in `bbdb-mode', with associated keybindings."
191 (wl-summary-redisplay)
192 (set-buffer (wl-message-get-original-buffer))
193 (let ((record (bbdb-wl-update-record t))
197 (bbdb-wl-pop-up-bbdb-buffer)
198 (bbdb-display-records (list record)))
200 (setq bbdb-win (get-buffer-window (get-buffer bbdb-buffer-name)))
202 (select-window bbdb-win))))
205 (defun bbdb-wl-pop-up-bbdb-buffer (&optional offer-to-create)
206 "Make the *BBDB* buffer be displayed along with the WL window(s),
207 displaying the record corresponding to the sender of the current message."
208 (if (get-buffer-window bbdb-buffer-name)
210 (let ((mes-win (get-buffer-window
212 (if (buffer-live-p wl-current-summary-buffer)
213 (set-buffer wl-current-summary-buffer))
214 wl-message-buf-name)))
215 (cur-win (selected-window))
216 (b (current-buffer)))
218 (select-window mes-win))
220 (- (window-height mes-win)
222 (- (window-height mes-win)
223 (max window-min-height
224 (1+ bbdb-pop-up-target-lines))))))
225 (split-window mes-win (if (> size 0) size window-min-height)))
226 ;; goto the bottom of the two...
227 (select-window (next-window))
228 ;; make it display *BBDB*...
229 (let ((pop-up-windows nil))
230 (switch-to-buffer (get-buffer-create bbdb-buffer-name)))
231 ;; select the original window we were in...
232 (select-window cur-win)
233 ;; and make sure the current buffer is correct as well.
235 (let ((bbdb-gag-messages t)
236 (bbdb-use-pop-up nil)
237 (bbdb-electric-p nil))
238 (let ((record (bbdb-wl-update-record offer-to-create))
239 (bbdb-elided-display (bbdb-pop-up-elided-display))
240 (b (current-buffer)))
241 (bbdb-display-records (if record (list record) nil))
245 (defun bbdb-wl-send-mail-internal (&optional to subj records)
247 (wl-draft (wl-address-header-extract-address to) "" (or subj ""))
248 (condition-case nil (delete-other-windows) (error))))
250 ;;; @ bbdb-extract-field-value -- stolen from tm-bbdb.
252 (and (not (fboundp 'bbdb-extract-field-value-internal))
253 ;;; (not (fboundp 'PLEASE_REPLACE_WITH_SEMI-BASED_MIME-BBDB)) ;; mime-bbdb
255 ;;; (require 'bbdb-hooks) ; not provided.
256 ;;; (or (fboundp 'bbdb-extract-field-value) ; defined as autoload
257 (or (fboundp 'bbdb-header-start)
259 (fset 'bbdb-extract-field-value-internal
261 ((fboundp 'tm:bbdb-extract-field-value)
262 (symbol-function 'tm:bbdb-extract-field-value))
263 (t (symbol-function 'bbdb-extract-field-value))))
264 (defun bbdb-extract-field-value (field)
265 (let ((value (bbdb-extract-field-value-internal field)))
266 (with-temp-buffer ; to keep raw buffer unibyte.
267 (elmo-set-buffer-multibyte
268 default-enable-multibyte-characters)
270 (eword-decode-string value)))))
276 ;;; bbdb-wl.el ends here