;;; -*- Mode:Emacs-Lisp -*-
;;; This file is the part of the Insidious Big Brother Database (aka BBDB),
;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <firstname.lastname@example.org>.
;;; Interface to VM (View Mail) 5.31 or greater. See bbdb.texinfo.
;;; The Insidious Big Brother Database is free software; you can redistribute
;;; it and/or modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 1, or (at your
;;; option) any later version.
;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY
;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; bbdb-vm.el,v 1.55 1998/04/11 07:06:47 simmonmt Exp
;; Revision 1.55 1998/04/11 07:06:47 simmonmt
;; Colin Rafferty's patch adding autoload cookies back
;; Revision 1.54 1998/02/23 07:14:01 simmonmt
;; Use add-hook, not bbdb-add-hook
;; Revision 1.53 1997/11/02 07:40:18 simmonmt
;; bbdb/vm-annotate-sender now takes REPLACE argument
;(require 'vm-motion) ; not provided, dammit!
(if (not (fboundp 'vm-record-and-change-message-pointer))
(if (not (fboundp 'vm-su-from))
(or (boundp 'vm-mode-map)
(defun bbdb/vm-get-from (msg)
(setq msg (vm-real-message-of msg))
;; Unfortunately the first arm of this if doesn't work because VM gloms
;; the various names and addresses of multi-recipient messages together
;; into one un-extractable mess. We could use just the parts before the
;; first comma in each string, but that loses when a user has a comma in
;; their name ("Jr." etc).
; (if (and (boundp 'vm-chop-full-name-function)
; (eq vm-chop-full-name-function 'mail-extract-address-components))
; ;; Good, VM is using mail-extr.el to do its parsing. That means
; ;; we can trust the junk in the pre-parsed message data.
; (let ((n (vm-su-full-name msg))
; (a (vm-su-from msg)))
; ;; if logged in user sent this, use recipients.
; (if (string-match (bbdb-user-mail-names) (or a ""))
; (setq n (vm-su-to-names msg)
; a (vm-su-to msg)))
; (if (= (length n) 0) (setq n nil))
; (if (= (length a) 0) (setq a nil))
; (if (equal n a) (setq n nil))
; (list n a))
;; Bad, VM isn't using mail-extr, so we need to find the folder buffer
;; and parse out the From: field ourselves...
;; Select the buffer containing the message.
;; Needed to handle VM virtual folders.
(set-buffer (vm-buffer-of msg))
(narrow-to-region (vm-start-of msg) (vm-end-of msg))
(let ((from (mail-fetch-field "from")))
(if (or (null from)
;; mail-strip-quoted-names is too broken!
(or (car (cdr (mail-extract-address-components
;; if logged in user sent this, use recipients.
(setq from (or (mail-fetch-field "to") from)))
(defun bbdb/vm-update-record (&optional offer-to-create)
"Returns the record corresponding to the current VM 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."
(let ((msg (car vm-message-pointer))
(inhibit-local-variables nil) ; vm binds this to t...
(enable-local-variables t) ; ...or vm bind this to nil.
(inhibit-quit nil)) ; vm damn well better not bind this to t!
;; this doesn't optimize the case of moving thru a folder where
;; few messages have associated records.
(or (bbdb-message-cache-lookup msg nil) ; nil = current-buffer
(let ((from (bbdb/vm-get-from msg)))
(defun bbdb/vm-annotate-sender (string &optional replace)
"Add a line to the end of the Notes field of the BBDB record
corresponding to the sender of this message. If REPLACE is non-nil,
replace the existing notes entry (if any)."
(interactive (list (if bbdb-readonly-p
(error "The Insidious Big Brother Database is read-only.")
(read-string "Comments: "))))
(bbdb-annotate-notes (bbdb/vm-update-record t) string 'notes replace))
(defun bbdb/vm-edit-notes (&optional arg)
"Edit the notes field or (with a prefix arg) a user-defined field
of the BBDB record corresponding to the sender of this message."
(let ((record (or (bbdb/vm-update-record t) (error ""))))
(bbdb-display-records (list record))
(bbdb-record-edit-property record nil t)
(bbdb-record-edit-notes record t))))
(defun bbdb/vm-show-sender ()
"Display the contents of the BBDB for the sender of this message.
This buffer will be in bbdb-mode, with associated keybindings."
(let ((record (bbdb/vm-update-record t)))
(bbdb-display-records (list record))
(defun bbdb/vm-pop-up-bbdb-buffer (&optional offer-to-create)
"Make the *BBDB* buffer be displayed along with the VM window(s),
displaying the record corresponding to the sender of the current message."
(function (lambda (w)
(let ((b (current-buffer)))
(set-buffer (window-buffer w))
(prog1 (eq major-mode 'vm-mode)
(let ((bbdb-gag-messages t)
(let ((record (bbdb/vm-update-record offer-to-create))
(bbdb-display-records (if record (list record) nil))
(defun bbdb/vm-record-and-change-message-pointer (old new)
(prog1 (bbdb-orig-vm-record-and-change-message-pointer old new)
;; By Alastair Burt <email@example.com>
;; vm 5.40 and newer support a new summary format, %U<letter>, to call
;; a user-provided function. Use "%-17.17UB" instead of "%-17.17F" to
;; have your VM summary buffers display BBDB's idea of the sender's full
;; name instead of the name (or lack thereof) in the message itself.
(defun vm-summary-function-B (m &optional to-p)
"Given a VM message returns the BBDB name of the sender.
(if (and vm-summary-uninteresting-senders (not to-p))
(let ((case-fold-search nil))
(if (string-match vm-summary-uninteresting-senders (vm-su-from m))
(vm-summary-function-B m t))
(or (bbdb/vm-alternate-full-name (vm-su-from m))
(or (bbdb/vm-alternate-full-name (if to-p (vm-su-to m) (vm-su-from m)))
(if to-p (vm-su-to-names m) (vm-su-full-name m)))))
(defun bbdb/vm-alternate-full-name (address)
(let ((entry (bbdb-search-simple nil
(if (and address bbdb-canonicalize-net-hook)
(or (bbdb-record-getprop entry 'mail-name)
(defun bbdb-insinuate-vm ()
"Call this function to hook BBDB into VM."
(cond ((boundp 'vm-select-message-hook) ; VM 5.36+
(add-hook 'vm-select-message-hook 'bbdb/vm-update-record))
((boundp 'vm-show-message-hook) ; VM 5.32.L+
(add-hook 'vm-show-message-hook 'bbdb/vm-update-record))
(error "vm versions older than 5.36 no longer supported")
;; Hack on to vm-record-and-change-message-pointer, since VM 5.32
;; doesn't have vm-show-message-hook.
(or (fboundp 'bbdb-orig-vm-record-and-change-message-pointer)
(define-key vm-mode-map ":" 'bbdb/vm-show-sender)
(define-key vm-mode-map ";" 'bbdb/vm-edit-notes)
;; VM used to inherit from mail-mode-map, so bbdb-insinuate-sendmail
;; did this. Kyle, you loser.
(if (boundp 'vm-mail-mode-map)
(define-key vm-mail-mode-map "\M-\t" 'bbdb-complete-name))