Commit e23c7dd8 authored by fenk's avatar fenk

This is the release version 2.35 of BBDB.

A diff of the SF CVS on '2005/07/24 15:22:58' and the XEmacs CVS shows only
differences in the expanded keywords of the lisp files.

Those evil CVS/RCS keywords will be removed  in the next BBDB version.
parent 37762ed578be
......@@ -23,11 +23,9 @@
;; $Id$
;;
(require 'cl)
(require 'bbdb)
;;(require 'bbdb-snarf) causes recursive compile!
(eval-when-compile
(require 'cl)
(defvar bbdb-extract-address-components-func)) ;; bbdb-snarf
;;(require 'bbdb-snarf) causes recursive compile, which I should fix.
;; ARGH. fmh, dammit.
(require
......@@ -66,6 +64,13 @@
(defvar bbdb-define-all-aliases-needs-rebuilt nil)
(defcustom bbdb-extract-address-components-func
'bbdb-rfc822-addresses
"Function called to parse one or more email addresses.
See bbdb-extract-address-components for an example."
:group 'bbdb-noticing-records
:type 'function)
(defcustom bbdb-default-country
'"Emacs";; what do you mean, it's not a country?
"*Default country to use if none is specified."
......@@ -1034,9 +1039,12 @@ section, then the entire field is edited, not just the current line."
;;
;; delete the old hash entry
(let ((name (bbdb-record-name bbdb-record))
(lastname (bbdb-record-lastname bbdb-record))
(company (bbdb-record-company bbdb-record)))
(if (> (length name) 0)
(bbdb-remhash (downcase name) bbdb-record))
(if (> (length lastname) 0)
(bbdb-remhash (downcase lastname) bbdb-record))
(if (> (length company) 0)
(bbdb-remhash (downcase company) bbdb-record)))
(bbdb-record-set-namecache bbdb-record nil)
......@@ -1061,10 +1069,7 @@ section, then the entire field is edited, not just the current line."
""))))))
;; delete the old hash entry
(let ((name (bbdb-record-name bbdb-record))
(company (bbdb-record-company bbdb-record)))
(if (> (length name) 0)
(bbdb-remhash (downcase name) bbdb-record))
(let ((company (bbdb-record-company bbdb-record)))
(if (> (length company) 0)
(bbdb-remhash (downcase company) bbdb-record)))
......@@ -1942,9 +1947,11 @@ the name is always included. If `bbdb-dwim-net-address-allow-redundancy' is
(or (fboundp 'vm-mail-internal)
(load-library "vm-reply")))) ; 5.31 or earlier
(vm-session-initialization)
(vm-mail-internal nil to subj)
(run-hooks 'vm-mail-hook)
(run-hooks 'vm-mail-mode-hook))
(if (not subj)
(vm-mail to)
(vm-mail-internal nil to subj)
(run-hooks 'vm-mail-hook)
(run-hooks 'vm-mail-mode-hook)))
((eq type 'message)
(or (fboundp 'message-mail) (autoload 'message-mail "message"))
(message-mail to subj))
......@@ -2225,21 +2232,34 @@ completion with."
)
(setq bbdb-complete-name-saved-window-config nil))))
(defvar bbdb-complete-name-callback-data nil
"Stores the buffer and region start and end of the completed string.
This is set in the *Completions* buffer.
It is set in `bbdb-display-completion-list' and used in the advice
`choose-completion-string'.")
(make-variable-buffer-local 'bbdb-complete-name-callback-data)
(defun bbdb-display-completion-list (list &optional callback data)
"Wrapper for `display-completion-list'.
GNU Emacs requires DATA to be in a specific format, viz. (nth 1 data) should
be a marker for the start of the region being completed."
;; disgusting hack to make GNU Emacs nuke the bit you've typed
;; when it inserts the completion.
(setq bbdb-complete-name-callback-data data)
(if (featurep 'xemacs)
(display-completion-list list :activate-callback callback
:user-data data)
(display-completion-list list)
;; disgusting hack to make GNU Emacs nuke the bit you've typed
;; when it inserts the completion.
(if data
(save-excursion
(set-buffer standard-output)
(setq completion-base-size
(- (marker-position (nth 1 data)) 1))))))
(display-completion-list list)))
(defadvice choose-completion-string (before bbdb-complete-fix activate)
"Deletes the completed string before replacing.
We need to do this as we are abusing completion and it was not meant to work
in buffer other than the mini buffer."
(when bbdb-complete-name-callback-data
(save-excursion
(set-buffer (car bbdb-complete-name-callback-data))
(apply 'delete-region (cdr bbdb-complete-name-callback-data)))))
(defun bbdb-complete-clicked-name (event extent user-data)
"Find the record for a name clicked in a completion buffer.
......@@ -2332,7 +2352,7 @@ Completion behaviour can be controlled with `bbdb-completion-type'."
(setq only-one-p nil))
(if (not (memq sym all-the-completions))
(setq all-the-completions (cons sym all-the-completions))))))
(completion (try-completion pattern ht pred))
(completion (progn (all-completions pattern ht pred) (try-completion pattern ht)))
(exact-match (eq completion t)))
(cond
......@@ -2418,6 +2438,15 @@ Completion behaviour can be controlled with `bbdb-completion-type'."
(length pattern))))
(setq match-recs (cons (car recs) match-recs)
matched t)))
;; Did we match on lastname?
(let ((b-r-name (or (bbdb-record-lastname (car recs)) "")))
(if (string= pattern
(substring (downcase b-r-name) 0
(min (length b-r-name)
(length pattern))))
(setq match-recs (cons (car recs) match-recs)
matched t)))
;; Did we match on aka?
(when (not matched)
......@@ -2500,7 +2529,7 @@ Completion behaviour can be controlled with `bbdb-completion-type'."
(not (string= completion last))
(setq last completion
pattern (downcase orig)
completion (try-completion pattern ht pred)))
completion (progn (all-completions pattern ht pred) (try-completion pattern ht))))
(if (stringp completion)
(progn (delete-region beg end)
(insert completion))))
......@@ -2738,7 +2767,8 @@ of all of those people."
(setq result (cdr result)))
(when (not use-abbrev-p)
(modify-syntax-entry ?* "w" mail-mode-header-syntax-table)
(if (boundp 'mail-mode-header-syntax-table)
(modify-syntax-entry ?* "w" mail-mode-header-syntax-table))
(sendmail-pre-abbrev-expand-hook))))
;; We should be cleverer here and instead of rebuilding all aliases we should
......@@ -2917,7 +2947,7 @@ try to use internal sound if available."
(condition-case nil
(play-sound (list 'sound
:file (aref bbdb-sound-files
(string-to-int num))
(string-to-number num))
:volume (or volume bbdb-sound-volume)))
(error nil)))
(if (and bbdb-sound-player
......
......@@ -2,7 +2,7 @@
;;; This file is part of the Insidious Big Brother Database (aka BBDB),
;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski <jwz@netscape.com>.
;;; Interface to GNUS version 3.12 or greater. See bbdb.texinfo.
;;; Interface to Gnus. 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
......@@ -77,7 +77,7 @@ The default is to annotate only new messages."
;;;###autoload
(defun bbdb/gnus-update-record (&optional offer-to-create)
"Return 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."
......@@ -87,7 +87,7 @@ the user confirms the creation."
;;;###autoload
(defun bbdb/gnus-update-records (&optional offer-to-create)
"Return the records corresponding to the current GNUS message, creating
"Return the records 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.
......@@ -198,7 +198,7 @@ This buffer will be in `bbdb-mode', with associated keybindings."
(bbdb/gnus-show-all-recipients)))))
(defun bbdb/gnus-pop-up-bbdb-buffer (&optional offer-to-create)
"Make the *BBDB* buffer be displayed along with the GNUS windows,
"Make the *BBDB* buffer be displayed along with the Gnus windows,
displaying the record corresponding to the sender of the current message."
(let ((bbdb-gag-messages t)
(records (bbdb/gnus-update-records offer-to-create))
......@@ -237,7 +237,7 @@ set gnus-optional-headers to 'bbdb/gnus-lines-and-from."
(defcustom bbdb/gnus-summary-mark-known-posters t
"*If t, mark messages created by people with records in the BBDB.
In GNUS, this marking will take place in the subject list (assuming
In Gnus, this marking will take place in the subject list (assuming
`gnus-optional-headers' contains `bbdb/gnus-lines-and-from'). In Gnus, the
marking will take place in the Summary buffer if the format code defined by
`bbdb/gnus-summary-user-format-letter' is used in `gnus-summary-line-format'.
......@@ -263,7 +263,7 @@ then for messages from authors who are in your database, the name
displayed will be the primary name in the database, rather than the
one in the From line of the message. This doesn't affect the names of
people who aren't in the database, of course. (`gnus-optional-headers'
must be `bbdb/gnus-lines-and-from' for GNUS users.)"
must be `bbdb/gnus-lines-and-from' for Gnus users.)"
:group 'bbdb-mua-specific-gnus
:type 'boolean)
(defvaralias 'bbdb/gnus-header-show-bbdb-names
......@@ -281,7 +281,7 @@ otherwise display his/her primary net address if we have one. If it
is set to the symbol bbdb, then real names will be used from the BBDB
if present, otherwise the net address in the post will be used. If
bbdb/gnus-summary-prefer-bbdb-data is nil, then this has no effect.
See `bbdb/gnus-lines-and-from' for GNUS users, or
See `bbdb/gnus-lines-and-from' for Gnus users, or
`bbdb/gnus-summary-user-format-letter' for Gnus users."
:group 'bbdb-mua-specific-gnus
:type '(choice (const :tag "Prefer real names" t)
......@@ -445,7 +445,7 @@ record contains a gnus-score field."
;;;###autoload
(defun bbdb/gnus-score (group)
"This returns a score alist for GNUS. A score pair will be made for
"This returns a score alist for Gnus. A score pair will be made for
every member of the net field in records which also have a gnus-score
field. This allows the BBDB to serve as a supplemental global score
file, with the advantage that it can keep up with multiple and changing
......@@ -700,7 +700,7 @@ determine the group and spooling priority for a single address."
;;;###autoload
(defun bbdb-insinuate-gnus ()
"Call this function to hook BBDB into GNUS."
"Call this function to hook BBDB into Gnus."
(setq gnus-optional-headers 'bbdb/gnus-lines-and-from)
(add-hook 'gnus-article-prepare-hook 'bbdb/gnus-pop-up-bbdb-buffer)
(add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)
......
......@@ -37,6 +37,7 @@
(require 'bbdb)
(require 'bbdb-com)
(require 'mail-parse)
(eval-when-compile
(condition-case()
......@@ -118,7 +119,7 @@ message. This will not necessarily be in the current buffer."
(defun bbdb-extract-field-value (field-name)
"Given the name of a field (like \"Subject\") this returns the value of
that field in the current message, or nil. This works whether you're in
GNUS, Rmail, or VM. This works on multi-line fields, but if more than
Gnus, Rmail, or VM. This works on multi-line fields, but if more than
one field of the same name is present, only the last is returned. It is
expected that the current buffer has a message in it, and (point) is at the
beginning of the message headers."
......@@ -147,7 +148,8 @@ beginning of the message headers."
(buffer-substring (match-end 0)
(progn (end-of-line 2) (point))))))))
(forward-line 1))
done)))
(and done
(mail-decode-encoded-word-string done)))))
(defcustom bbdb-ignore-most-messages-alist '()
"*An alist describing which messages to automatically create BBDB
......
......@@ -149,9 +149,12 @@ Returns the Grand Unified Record."
;; fix up the in-memory copy.
(bbdb-change-record merge-record t)
(let ((name (bbdb-record-name merge-record))
(lastname (bbdb-record-lastname merge-record))
(company (bbdb-record-company merge-record)))
(if (> (length name) 0)
(bbdb-remhash (downcase name) merge-record))
(if (> (length lastname) 0)
(bbdb-remhash (downcase lastname) merge-record))
(if (> (length company) 0)
(bbdb-remhash (downcase company) merge-record)))
(bbdb-record-set-namecache merge-record nil)
......
......@@ -85,9 +85,11 @@ the user confirms the creation."
from t
(or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)
offer-to-create)
offer-to-create)))
(if (and msg record) (bbdb-encache-message msg (list record)))
;; return one record
;; ugh. what the hell?
(or offer-to-create
(bbdb-invoke-hook-for-value bbdb/mail-auto-create-p)))))
(if (and msg record) (bbdb-encache-message msg (list record)))
;; return one record
record))))))
;;;###autoload
......
......@@ -23,72 +23,6 @@
;;
;; $Id$
;;
;; $Log$
;; Revision 1.20 2004/03/22 15:55:03 waider
;; * Minor docstring fix (Stefan Monnier)
;; * Catch error if attempting to kill only window in frame (Stefan Monnier)
;;
;; Revision 1.19 2002/08/19 22:49:12 waider
;; Jim Blandy's fix for migrating notes.
;;
;; Revision 1.18 2002/05/12 22:17:03 waider
;; Dave Love's big patch. See ChangeLog for full details.
;;
;; Revision 1.17 2001/05/17 17:15:31 fenk
;; (bbdb-unmigrate-zip-codes-to-strings): Fixed the faulty use of let instead of let*.
;;
;; Revision 1.16 2000/11/27 12:59:53 waider
;; Alex's zipcode changes. WARNING: New database format.
;;
;; Revision 1.15 2000/08/05 15:38:04 waider
;; When converting the streets to a list, delete "nil" as well as "".
;;
;; Revision 1.14 2000/07/11 21:28:44 sds
;; (bbdb-migrate-record-lambda): `mapcar', not `mapc' here!
;;
;; Revision 1.13 2000/07/10 17:00:12 sds
;; revert the last patch (`mapc' is more efficient than `mapcar')
;;
;; Revision 1.12 2000/07/09 09:20:11 waider
;; GNUmacs doesn't have "mapc".
;;
;; Revision 1.11 2000/07/05 21:43:35 sds
;; rewrote migration in a modular way
;;
;; Revision 1.10 2000/06/30 19:12:36 sds
;; (bbdb-migrate): re-wrote using `mapcar' instead of `append'
;; this is linear instead of quadratic and avoids much consing
;;
;; Revision 1.9 2000/05/29 22:47:50 waider
;; *** empty log message ***
;;
;; Revision 1.8 2000/04/17 08:30:47 waider
;; omitted bracket on unmigrate for v5->v4
;;
;; Revision 1.7 2000/04/16 04:00:54 waider
;; * Added 5->4 unmigration
;;
;; Revision 1.6 2000/04/15 14:57:38 waider
;; * Fixed misplaced bracket in street migration code.
;;
;; Revision 1.5 2000/04/12 23:57:16 waider
;; * Added v5 migration. NB no back-migration yet.
;;
;; Revision 1.4 2000/04/05 16:45:07 bbdb-writer
;; * Added Alex's BBDB v4 format migration (country field)
;;
;; Revision 1.3 1998/10/10 18:47:21 simmonmt
;; From slbaur: Don't pass an integer to concat.
;; Format dates with number format - not string - so we get leading
;; zeros.
;;
;; Revision 1.2 1998/04/11 07:19:19 simmonmt
;; Colin Rafferty's patch adding autoload cookies back
;;
;; Revision 1.1 1998/01/06 06:06:06 simmonmt
;; Initial revision
;;
;;
(require 'bbdb)
......@@ -282,7 +216,7 @@ This uses the code that used to be in bbdb-parse-zip-string."
(zip (cond ((string-match "^[ \t\n]*$" string) 0)
;; Matches 1 to 6 digits.
((string-match "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" string)
(string-to-int string))
(string-to-number string))
;; Matches 5 digits and 3 or 4 digits.
((string-match "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" string)
(list (bbdb-subint string 1) (bbdb-subint string 2)))
......@@ -336,9 +270,9 @@ argument."
["0" "0" "0" "0" nil])
(cond ((string-match
"^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date)
(setq parsed (vector (string-to-int (match-string 1 date))
(string-to-int (match-string 2 date))
(string-to-int (match-string 3 date))))
(setq parsed (vector (string-to-number (match-string 1 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 3 date))))
;; This should be fairly loud for GNU Emacs users
(bbdb-warn "BBDB is treating %s field value %s as %s %d %d"
(car field) (cdr field)
......@@ -348,9 +282,9 @@ argument."
(aref parsed 2) (aref parsed 0)))
((string-match
"^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date)
(setq parsed (vector (string-to-int (match-string 3 date))
(string-to-int (match-string 1 date))
(string-to-int (match-string 2 date))))
(setq parsed (vector (string-to-number (match-string 3 date))
(string-to-number (match-string 1 date))
(string-to-number (match-string 2 date))))
;; This should be fairly loud for GNU Emacs users
(bbdb-warn "BBDB is treating %s field value %s as %s %d %d"
(car field) (cdr field)
......@@ -362,11 +296,11 @@ argument."
;; I like numbers
(and (stringp (aref parsed 0))
(aset parsed 0 (string-to-int (aref parsed 0))))
(aset parsed 0 (string-to-number (aref parsed 0))))
(and (stringp (aref parsed 1))
(aset parsed 1 (string-to-int (aref parsed 1))))
(aset parsed 1 (string-to-number (aref parsed 1))))
(and (stringp (aref parsed 2))
(aset parsed 2 (string-to-int (aref parsed 2))))
(aset parsed 2 (string-to-number (aref parsed 2))))
;; Sanity check
(cond ((and (< 0 (aref parsed 0))
......
......@@ -55,61 +55,6 @@
;;
;; $Id$
;;
;; $Log$
;; Revision 1.68 2004/10/13 13:37:06 waider
;; * Correct variable name in comment
;;
;; Revision 1.67 2001/11/19 21:35:08 waider
;; Patch from Alex Schroeder
;;
;; Revision 1.66 2001/09/11 10:55:31 fenk
;; Appliend fixed according to change log
;;
;; Revision 1.65 2000/11/27 12:59:53 waider
;; Alex's zipcode changes. WARNING: New database format.
;;
;; Revision 1.64 2000/07/13 17:07:00 sds
;; minor doc fixes to comply with the standards
;;
;; Revision 1.63 2000/05/29 22:47:50 waider
;; *** empty log message ***
;;
;; Revision 1.62 2000/04/15 17:11:49 kuepper
;; Adopt TeX-output of streets to new file-format v5.
;;
;; Revision 1.61 2000/04/13 17:19:58 kuepper
;; Improved TeX output (fonts, breaks).
;;
;; Revision 1.60 2000/04/13 00:22:23 waider
;; * Address layout patch, including Euro addresses and the streets->list thing
;;
;; Revision 1.59 1998/11/02 07:08:14 simmonmt
;; Change mailing list address
;;
;; Revision 1.58 1998/10/17 19:43:26 simmonmt
;; Patch to convert default area code protection from condition-case to
;; integerp.
;;
;; Revision 1.57 1998/04/11 07:19:32 simmonmt
;; Colin Rafferty's patch adding autoload cookies back
;;
;; Revision 1.56 1998/03/10 07:37:42 simmonmt
;; Protecting bbdb-default-area-code
;;
;; Revision 1.55 1998/02/23 07:12:40 simmonmt
;; Moved key binding to bbdb.el, changed default of bbdb-print-elide,
;; fixed problem with nil bbdb-default-area-code
;;
;; Revision 1.54 1998/01/06 06:08:38 simmonmt
;; Customized variables and removed autoloads
;;
;; Revision 1.53 1997/12/01 05:02:28 simmonmt
;; Soren Dayton's fix to correct tilde printing
;;
;; Revision 1.52 1997/10/06 01:05:28 simmonmt
;; New version of bbdb-print from Boris Goldowsky <boris@gnu.ai.mit.edu>
;;
;;
;;; Installation:
;;;
......
......@@ -17,21 +17,16 @@
;;; 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.
;;
;; $Id$
;;
(eval-when-compile
(require 'bbdb)
(require 'bbdb-com)
(require 'rmail)
;(require 'rmailsum) ; not provided, dammit!
(if (not (fboundp 'rmail-make-summary-line))
(load-library "rmailsum"))
;; just to avoid a warning
(if (not (boundp 'rmail-buffer))
(defvar rmail-buffer nil)))
(require 'bbdb)
(require 'bbdb-com)
(require 'rmail)
(require 'rmailsum)
(require 'mailheader)
;;;###autoload
(defun bbdb/rmail-update-record (&optional offer-to-create)
......@@ -39,39 +34,79 @@
(records (bbdb/rmail-update-records offer-to-create)))
(if records (car records) nil)))
(defun bbdb/rmail-get-header-content( header-field buf )
"Pull HEADER-FIELD out of BUF's mail header.
BUF is actually the rmail buffer from which the current message should
be extracted."
(save-excursion
(set-buffer buf)
(save-restriction
(rmail-narrow-to-non-pruned-header)
(let ((headers (mail-header-extract))
(header (intern-soft (downcase header-field))))
(mail-header header headers)))))
(defun bbdb/rmail-new-flag( buf )
"Returns t if the current message in buffer BUF is new."
(rmail-message-labels-p rmail-current-message ", ?\\(unseen\\),"))
(defcustom bbdb/rmail-update-records-mode
'(if (bbdb/rmail-new-flag rmail-buffer) 'annotating 'searching)
"RMAIL-specific version of `bbdb-update-records-mode', which see."
:group 'bbdb-mua-specific-rmail
:type '(choice (const :tag "annotating all messages"
annotating)
(const :tag "annotating no messages"
searching)
(const :tag "annotating only new messages"
(if (bbdb/rmail-new-flag rmail-buffer) 'annotating 'searching))
(sexp :tag "user defined")))
;;;###autoload
(defun bbdb/rmail-update-records (&optional offer-to-create)
"Returns the records corresponding to the current RMAIL 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/rmail-pop-up-bbdb-buffer offer-to-create)
(if (and (boundp 'rmail-buffer) rmail-buffer)
(set-buffer rmail-buffer))
(if rmail-current-message
(let ((records (bbdb-message-cache-lookup rmail-current-message))
record)
(or records
(save-excursion
(let ((from (mail-fetch-field "from")))
(if (or (null from)
(string-match (bbdb-user-mail-names)
(mail-strip-quoted-names from)))
;; if logged-in user sent this, use recipients.
(setq from (or (mail-fetch-field "to") from)))
(if from
(setq record
(bbdb-annotate-message-sender
from t
(or (bbdb-invoke-hook-for-value
bbdb/mail-auto-create-p)
offer-to-create)
offer-to-create)))
;; return a list of records
(if record
(bbdb-encache-message
rmail-current-message
(list record))))))))))
"Returns the records corresponding to the current RMAIL emssage,
creating or modifying them 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/rmail-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 n this message, but it will search only for existing records.
When hitting C-g again it will stop scanning."
(if (and (boundp 'rmail-buffer) rmail-buffer)
(set-buffer rmail-buffer)
(error "Not in an rmail buffer"))
(if rmail-current-message
(let ((bbdb/rmail-offer-to-create offer-to-create)
cache records)
(if (not bbdb/rmail-offer-to-create)
(setq cache (bbdb-message-cache-lookup
rmail-current-message)))
(if cache
(setq records (if bbdb-get-only-first-address-p
(list (car cache))
cache))
(let ((bbdb-update-records-mode (or
bbdb/rmail-update-records-mode
bbdb-update-records-mode)))
(setq records (bbdb-update-records
(bbdb-get-addresses
bbdb-get-only-first-address-p
;; uninteresting-senders
user-mail-address
'bbdb/rmail-get-header-content
rmail-buffer)
bbdb/mail-auto-create-p
offer-to-create))
(bbdb-encache-message rmail-current-message records)))
records))
)
;;;###autoload
(defun bbdb/rmail-annotate-sender (string &optional replace)
......@@ -108,46 +143,35 @@ This buffer will be in bbdb-mode, with associated keybindings."
(bbdb-display-records (list record))
(error "unperson"))))
(defun bbdb/rmail-pop-up-bbdb-buffer (&optional offer-to-create)
"Make the *BBDB* buffer be displayed along with the RMAIL window(s),
displaying the record corresponding to the sender of the current message."
(bbdb-pop-up-bbdb-buffer
(function (lambda (w)
(let ((b (current-buffer)))
(set-buffer (window-buffer w))
(prog1 (eq major-mode 'rmail-mode)
(set-buffer b))))))
(let ((bbdb-gag-messages t)
(bbdb-use-pop-up nil)
(bbdb-electric-p nil))
(let ((records (bbdb/rmail-update-records offer-to-create))