git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus-bbdb.el

   1 ;; gnus-bbdb.el --- Interface to Semi-gnus
   2
   3 ;; Copyright (c) 1991,1992,1993 Jamie Zawinski <jwz@netscape.com>.
   4 ;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI
   5 ;; Copyright (C) 1997,1998 MORIOKA Tomohiko
   6 ;; Copyright (C) 1998 Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
   7
   8 ;; Author: Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
   9 ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
  10 ;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news
  11
  12 ;; This file is part of Semi-gnus.
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Code:
  30
  31 (require 'bbdb)
  32 (require 'gnus)
  33 (require 'std11)
  34 (eval-when-compile
  35   (require 'gnus-win))
  36
  37 (defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body
  38   "*Field body decoder.")
  39
  40 (defmacro gnus-bbdb/decode-field-body (field-body field-name)
  41   `(or (and (functionp gnus-bbdb/decode-field-body-function)
  42             (funcall gnus-bbdb/decode-field-body-function
  43                      ,field-body ,field-name))
  44        ,field-body))
  45
  46 ;;;###autoload
  47 (defun gnus-bbdb/update-record (&optional offer-to-create)
  48   "returns the record corresponding to the current GNUS message, creating
  49 or modifying it as necessary.  A record will be created if
  50 bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and
  51 the user confirms the creation."
  52   (if bbdb-use-pop-up
  53       (gnus-bbdb/pop-up-bbdb-buffer offer-to-create)
  54     (save-excursion
  55       (save-restriction
  56         (let (from)
  57           (set-buffer gnus-original-article-buffer)
  58           (widen)
  59           (narrow-to-region (point-min)
  60                             (progn (goto-char (point-min))
  61                                    (or (search-forward "\n\n" nil t)
  62                                        (error "message unexists"))
  63                                    (- (point) 2)))
  64           (when (setq from (mail-fetch-field "from"))
  65             (setq from (gnus-bbdb/extract-address-components
  66                         (gnus-bbdb/decode-field-body from 'From))))
  67           (when (and (car (cdr from))
  68                      (string-match (bbdb-user-mail-names)
  69                                    (car (cdr from))))
  70             ;; if logged-in user sent this, use recipients.
  71             (let ((to (mail-fetch-field "to")))
  72               (when to
  73                 (setq from
  74                       (gnus-bbdb/extract-address-components
  75                        (gnus-bbdb/decode-field-body to 'To))))))
  76         (when from
  77           (bbdb-annotate-message-sender from t
  78                                         (or (bbdb-invoke-hook-for-value
  79                                              bbdb/news-auto-create-p)
  80                                             offer-to-create)
  81                                         offer-to-create)))))))
  82
  83 ;;;###autoload
  84 (defun gnus-bbdb/annotate-sender (string &optional replace)
  85   "Add a line to the end of the Notes field of the BBDB record
  86 corresponding to the sender of this message.  If REPLACE is non-nil,
  87 replace the existing notes entry (if any)."
  88   (interactive (list (if bbdb-readonly-p
  89                          (error "The Insidious Big Brother Database is read-only.")
  90                          (read-string "Comments: "))))
  91   (bbdb-annotate-notes (gnus-bbdb/update-record t) string 'notes replace))
  92
  93 (defun gnus-bbdb/edit-notes (&optional arg)
  94   "Edit the notes field or (with a prefix arg) a user-defined field
  95 of the BBDB record corresponding to the sender of this message."
  96   (interactive "P")
  97   (let ((record (or (gnus-bbdb/update-record t) (error ""))))
  98     (bbdb-display-records (list record))
  99     (if arg
 100         (bbdb-record-edit-property record nil t)
 101       (bbdb-record-edit-notes record t))))
 102
 103 ;;;###autoload
 104 (defun gnus-bbdb/show-sender ()
 105   "Display the contents of the BBDB for the sender of this message.
 106 This buffer will be in bbdb-mode, with associated keybindings."
 107   (interactive)
 108   (let ((record (gnus-bbdb/update-record t)))
 109     (if record
 110         (bbdb-display-records (list record))
 111         (error "unperson"))))
 112
 113 ;; Avoid byte-compile warning.
 114 (defvar bbdb-pop-up-elided-display)
 115
 116 (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create)
 117   "Make the *BBDB* buffer be displayed along with the GNUS windows,
 118 displaying the record corresponding to the sender of the current message."
 119   (let ((bbdb-gag-messages t)
 120         (bbdb-use-pop-up nil)
 121         (bbdb-electric-p nil))
 122     (let ((record (gnus-bbdb/update-record offer-to-create))
 123           (bbdb-elided-display (bbdb-pop-up-elided-display))
 124           (b (current-buffer)))
 125       ;; display the bbdb buffer iff there is a record for this article.
 126       (cond (record
 127              (bbdb-pop-up-bbdb-buffer
 128               (function (lambda (w)
 129                           (let ((b (current-buffer)))
 130                             (set-buffer (window-buffer w))
 131                             (prog1 (or (eq major-mode 'mime-veiw-mode)
 132                                        (eq major-mode 'gnus-article-mode))
 133                                    (set-buffer b))))))
 134              (bbdb-display-records (list record)))
 135             (t
 136              (or bbdb-inside-electric-display
 137                  (not (get-buffer-window bbdb-buffer-name))
 138                  (let (w)
 139                    (delete-other-windows)
 140                    (if (assq 'article gnus-buffer-configuration)
 141                        (gnus-configure-windows 'article)
 142                      (gnus-configure-windows 'SelectArticle))
 143                    (if (setq w (get-buffer-window gnus-summary-buffer))
 144                        (select-window w))
 145                    ))))
 146       (set-buffer b)
 147       record)))
 148
 149 ;;
 150 ;; Announcing BBDB entries in the summary buffer
 151 ;;
 152
 153 (defcustom gnus-bbdb/lines-and-from-length 18
 154   "*The number of characters used to display From: info in Gnus, if you have
 155 set gnus-optional-headers to 'gnus-bbdb/lines-and-from."
 156   :group 'bbdb-mua-specific-gnus
 157   :type 'integer)
 158
 159 (defcustom gnus-bbdb/summary-mark-known-posters t
 160   "*If t, mark messages created by people with records in the BBDB.
 161 In GNUS, this marking will take place in the subject list (assuming
 162 `gnus-optional-headers' contains `gnus-bbdb/lines-and-from').  In Gnus, the
 163 marking will take place in the Summary buffer if the format code defined by
 164 `gnus-bbdb/summary-user-format-letter' is used in `gnus-summary-line-format'.
 165 This variable has no effect on the marking controlled by
 166 `gnus-bbdb/summary-in-bbdb-format-letter'."
 167   :group 'bbdb-mua-specific-gnus
 168   :type '(choice (const :tag "Mark known posters" t)
 169                  (const :tag "Do not mark known posters" nil)))
 170 (defvaralias 'gnus-bbdb/mark-known-posters
 171   'gnus-bbdb/summary-mark-known-posters)
 172
 173 (defcustom gnus-bbdb/summary-known-poster-mark "+"
 174   "This is the default character to prefix author names with if
 175 gnus-bbdb/summary-mark-known-posters is t.  If the poster's record has
 176 an entry in the field named by bbdb-message-marker-field, then that will
 177 be used instead."
 178   :group 'bbdb-mua-specific-gnus
 179   :type 'character)
 180
 181 (defcustom gnus-bbdb/summary-show-bbdb-names t
 182   "*If both this variable and `gnus-bbdb/summary-prefer-real-names' are true,
 183 then for messages from authors who are in your database, the name
 184 displayed will be the primary name in the database, rather than the
 185 one in the From line of the message.  This doesn't affect the names of
 186 people who aren't in the database, of course.  (`gnus-optional-headers'
 187 must be `gnus-bbdb/lines-and-from' for GNUS users.)"
 188   :group 'bbdb-mua-specific-gnus
 189   :type 'boolean)
 190 (defvaralias 'gnus-bbdb/header-show-bbdb-names
 191   'gnus-bbdb/summary-show-bbdb-names)
 192
 193 (defcustom gnus-bbdb/summary-prefer-bbdb-data t
 194   "If t, then for posters who are in our BBDB, replace the information
 195 provided in the From header with data from the BBDB."
 196   :group 'bbdb-mua-specific-gnus
 197   :type 'boolean)
 198
 199 (defcustom gnus-bbdb/summary-prefer-real-names t
 200   "If t, then display the poster's name from the BBDB if we have one,
 201 otherwise display his/her primary net address if we have one.  If it
 202 is set to the symbol bbdb, then real names will be used from the BBDB
 203 if present, otherwise the net address in the post will be used.  If
 204 gnus-bbdb/summary-prefer-bbdb-data is nil, then this has no effect.
 205 See `gnus-bbdb/lines-and-from' for GNUS users, or
 206 `gnus-bbdb/summary-user-format-letter' for Gnus users."
 207   :group 'bbdb-mua-specific-gnus
 208   :type '(choice (const :tag "Prefer real names" t)
 209                  (const :tag "Prefer network addresses" nil)))
 210 (defvaralias 'gnus-bbdb/header-prefer-real-names
 211   'gnus-bbdb/summary-prefer-real-names)
 212
 213 (defcustom gnus-bbdb/summary-user-format-letter "B"
 214   "This is the gnus-user-format-function- that will be used to insert
 215 the information from the BBDB in the summary buffer (using
 216 `gnus-bbdb/summary-get-author').  This format code is meant to replace
 217 codes that insert sender names or addresses (like %A or %n). Unless
 218 you've alread got other code using user format B, you might as well
 219 stick with the default.  Additionally, if the value of this variable
 220 is nil, no format function will be installed for
 221 `gnus-bbdb/summary-get-author'.  See also
 222 `gnus-bbdb/summary-in-bbdb-format-letter', which installs a format
 223 code for `gnus-bbdb/summary-author-in-bbdb'"
 224   :group 'bbdb-mua-specific-gnus
 225   :type 'character)
 226
 227 (defcustom gnus-bbdb/summary-in-bbdb-format-letter "b"
 228   "This is the gnus-user-format-function- that will be used to insert
 229 `gnus-bbdb/summary-known-poster-mark' (using
 230 `gnus-bbdb/summary-author-in-bbdb') if the poster is in the BBDB, and
 231 \" \" if not.  If the value of this variable is nil, no format code
 232 will be installed for `gnus-bbdb/summary-author-in-bbdb'.  See also
 233 `gnus-bbdb/summary-user-format-letter', which installs a format code
 234 for `gnus-bbdb/summary-get-author'."
 235   :group 'bbdb-mua-specific-gnus
 236   :type 'character)
 237
 238 (defcustom bbdb-message-marker-field 'mark-char
 239   "*The field whose value will be used to mark messages by this user in Gnus."
 240   :group 'bbdb-mua-specific-gnus
 241   :type 'symbol)
 242
 243 ;;;###autoload
 244 (defun gnus-bbdb/lines-and-from (header)
 245   "Useful as the value of gnus-optional-headers in *GNUS* (not Gnus).
 246 NOTE: This variable no longer seems to be present in Gnus.  It seems
 247 to have been replaced by `message-default-headers', which only takes
 248 strings.  In the future this should change."
 249   (let* ((length gnus-bbdb/lines-and-from-length)
 250          (lines (mail-header-lines header))
 251          (from (mail-header-from header))
 252          (data (and (or gnus-bbdb/summary-mark-known-posters
 253                         gnus-bbdb/summary-show-bbdb-names)
 254                     (condition-case ()
 255                         (gnus-bbdb/extract-address-components from)
 256                       (error nil))))
 257          (name (car data))
 258          (net (car (cdr data)))
 259          (record (and data
 260                       (bbdb-search-simple name
 261                        (if (and net bbdb-canonicalize-net-hook)
 262                            (bbdb-canonicalize-address net)
 263                          net))))
 264          string L)
 265
 266     (if (and record name (member (downcase name) (bbdb-record-net record)))
 267         ;; bogon!
 268         (setq record nil))
 269
 270     (setq name
 271           (or (and gnus-bbdb/summary-prefer-bbdb-data
 272                    (or (and gnus-bbdb/summary-prefer-real-names
 273                             (and record (bbdb-record-name record)))
 274                        (and record (bbdb-record-net record)
 275                             (nth 0 (bbdb-record-net record)))))
 276               (and gnus-bbdb/summary-prefer-real-names
 277                    (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb)
 278                             net)
 279                        name))
 280               net from "**UNKNOWN**"))
 281       ;; GNUS can't cope with extra square-brackets appearing in the summary.
 282       (if (and name (string-match "[][]" name))
 283           (progn (setq name (copy-sequence name))
 284                  (while (string-match "[][]" name)
 285                    (aset name (match-beginning 0) ? ))))
 286       (setq string (format "%s%3d:%s"
 287                            (if (and record gnus-bbdb/summary-mark-known-posters)
 288                                (or (bbdb-record-getprop
 289                                     record bbdb-message-marker-field)
 290                                    "*")
 291                              " ")
 292                            lines (or name from))
 293             L (length string))
 294       (cond ((> L length) (substring string 0 length))
 295             ((< L length) (concat string (make-string (- length L) ? )))
 296             (t string))))
 297
 298 (defun gnus-bbdb/summary-get-author (header)
 299   "Given a Gnus message header, returns the appropriate piece of
 300 information to identify the author in a Gnus summary line, depending on
 301 the settings of the various configuration variables.  See the
 302 documentation for the following variables for more details:
 303   `gnus-bbdb/summary-mark-known-posters'
 304   `gnus-bbdb/summary-known-poster-mark'
 305   `gnus-bbdb/summary-prefer-bbdb-data'
 306   `gnus-bbdb/summary-prefer-real-names'
 307 This function is meant to be used with the user function defined in
 308   `gnus-bbdb/summary-user-format-letter'"
 309   (let* ((from (mail-header-from header))
 310          (data (and gnus-bbdb/summary-show-bbdb-names
 311                     (condition-case ()
 312                         (gnus-bbdb/extract-address-components from)
 313                       (error nil))))
 314          (name (car data))
 315          (net (car (cdr data)))
 316          (record (and data
 317                       (bbdb-search-simple name
 318                        (if (and net bbdb-canonicalize-net-hook)
 319                            (bbdb-canonicalize-address net)
 320                          net)))))
 321     (if (and record name (member (downcase name) (bbdb-record-net record)))
 322         ;; bogon!
 323         (setq record nil))
 324     (setq name
 325           (or (and gnus-bbdb/summary-prefer-bbdb-data
 326                    (or (and gnus-bbdb/summary-prefer-real-names
 327                             (and record (bbdb-record-name record)))
 328                        (and record (bbdb-record-net record)
 329                             (nth 0 (bbdb-record-net record)))))
 330               (and gnus-bbdb/summary-prefer-real-names
 331                    (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb)
 332                             net)
 333                        name))
 334               net from "**UNKNOWN**"))
 335     (format "%s%s"
 336             (or (and record gnus-bbdb/summary-mark-known-posters
 337                      (or (bbdb-record-getprop
 338                           record bbdb-message-marker-field)
 339                          gnus-bbdb/summary-known-poster-mark))
 340                 " ")
 341             name)))
 342
 343 ;; DEBUG: (gnus-bbdb/summary-author-in-bbdb "From: simmonmt@acm.org")
 344 (defun gnus-bbdb/summary-author-in-bbdb (header)
 345   "Given a Gnus message header, returns a mark if the poster is in the BBDB, \" \" otherwise.  The mark itself is the value of the field indicated by `bbdb-message-marker-field' (`mark-char' by default) if the indicated field is in the poster's record, and `gnus-bbdb/summary-known-poster-mark' otherwise."
 346   (let* ((from (mail-header-from header))
 347          (data (condition-case ()
 348                    (gnus-bbdb/extract-address-components from)
 349                  (error nil)))
 350          (name (car data))
 351          (net (cadr data))
 352          record)
 353     (if (and data
 354              (setq record
 355                    (bbdb-search-simple
 356                     name (if (and net bbdb-canonicalize-net-hook)
 357                              (bbdb-canonicalize-address net)
 358                            net))))
 359         (or (bbdb-record-getprop
 360              record bbdb-message-marker-field)
 361             gnus-bbdb/summary-known-poster-mark) " ")))
 362
 363 ;;
 364 ;; Scoring
 365 ;;
 366
 367 (defcustom gnus-bbdb/score-field 'gnus-score
 368   "This variable contains the name of the BBDB field which should be
 369 checked for a score to add to the net addresses in the same record."
 370   :group 'bbdb-mua-specific-gnus-scoring
 371   :type 'symbol)
 372
 373 (defcustom gnus-bbdb/score-default nil
 374   "If this is set, then every net address in the BBDB that does not have
 375 an associated score field will be assigned this score.  A value of nil
 376 implies a default score of zero."
 377   :group 'bbdb-mua-specific-gnus-scoring
 378   :type '(choice (const :tag "Do not assign default score")
 379                  (integer :tag "Assign this default score" 0)))
 380
 381 (defvar gnus-bbdb/score-default-internal nil
 382   "Internal variable for detecting changes to
 383 `gnus-bbdb/score-default'.  You should not set this variable directly -
 384 set `gnus-bbdb/score-default' instead.")
 385
 386 (defvar gnus-bbdb/score-alist nil
 387   "The text version of the scoring structure returned by
 388 gnus-bbdb/score.  This is built automatically from the BBDB.")
 389
 390 (defvar gnus-bbdb/score-rebuild-alist t
 391   "Set to t to rebuild gnus-bbdb/score-alist on the next call to
 392 gnus-bbdb/score.  This will be set automatically if you change a BBDB
 393 record which contains a gnus-score field.")
 394
 395 (defun gnus-bbdb/score-invalidate-alist (rec)
 396   "This function is called through bbdb-after-change-hook, and sets
 397 gnus-bbdb/score-rebuild-alist to t if the changed record contains a
 398 gnus-score field."
 399   (if (bbdb-record-getprop rec gnus-bbdb/score-field)
 400       (setq gnus-bbdb/score-rebuild-alist t)))
 401
 402 ;;;###autoload
 403 (defun gnus-bbdb/score (group)
 404   "This returns a score alist for GNUS.  A score pair will be made for
 405 every member of the net field in records which also have a gnus-score
 406 field.  This allows the BBDB to serve as a supplemental global score
 407 file, with the advantage that it can keep up with multiple and changing
 408 addresses better than the traditionally static global scorefile."
 409   (list (list
 410    (condition-case nil
 411        (read (gnus-bbdb/score-as-text group))
 412      (error (setq gnus-bbdb/score-rebuild-alist t)
 413             (message "Problem building BBDB score table.")
 414             (ding) (sit-for 2)
 415             nil)))))
 416
 417 (defun gnus-bbdb/score-as-text (group)
 418   "Returns a SCORE file format string built from the BBDB."
 419   (cond ((or (cond ((/= (or gnus-bbdb/score-default 0)
 420                         (or gnus-bbdb/score-default-internal 0))
 421                     (setq gnus-bbdb/score-default-internal
 422                           gnus-bbdb/score-default)
 423                     t))
 424             (not gnus-bbdb/score-alist)
 425             gnus-bbdb/score-rebuild-alist)
 426     (setq gnus-bbdb/score-rebuild-alist nil)
 427     (setq gnus-bbdb/score-alist
 428           (concat "((touched nil) (\"from\"\n"
 429                   (mapconcat
 430                    (lambda (rec)
 431                      (let ((score (or (bbdb-record-getprop rec
 432                                                            gnus-bbdb/score-field)
 433                                       gnus-bbdb/score-default))
 434                            (net (bbdb-record-net rec)))
 435                        (if (not (and score net)) nil
 436                          (mapconcat
 437                           (lambda (addr)
 438                             (concat "(\"" addr "\" " score ")\n"))
 439                           net ""))))
 440                    (bbdb-records) "")
 441                   "))"))))
 442   gnus-bbdb/score-alist)
 443
 444 (defun gnus-bbdb/extract-field-value-init ()
 445   (when (or (and (eq (current-buffer) (get-buffer gnus-article-buffer))
 446                  (buffer-live-p gnus-original-article-buffer)
 447                  (set-buffer gnus-original-article-buffer))
 448             (eq (current-buffer) (get-buffer gnus-original-article-buffer)))
 449     (widen)
 450     (narrow-to-region (point-min)
 451                       (progn (goto-char (point-min))
 452                              (or (search-forward "\n\n" nil t)
 453                                  (error "message unexists"))
 454                              (- (point) 2)))
 455     'gnus-bbdb/extract-field-value))
 456
 457 (defun gnus-bbdb/extract-field-value (field-name)
 458   "Given the name of a field (like \"Subject\") this returns the value of
 459 that field in the current message, or nil.  This works whether you're in
 460 Semi-gnus, Rmail, or VM.  This works on multi-line fields, but if more than
 461 one field of the same name is present, only the last is returned.  It is
 462 expected that the current buffer has a message in it, and (point) is at the
 463 beginning of the message headers."
 464   ;; we can't special-case VM here to use its cache, because the cache has
 465   ;; divided real-names from addresses; the actual From: and Subject: fields
 466   ;; exist only in the message.
 467   (let (value)
 468     (when (setq value (mail-fetch-field field-name))
 469       (gnus-bbdb/decode-field-body value field-name))))
 470
 471 ;;; @ mail-extr
 472 ;;;
 473
 474 (defvar gnus-bbdb/canonicalize-full-name-methods
 475   '(gnus-bbdb/canonicalize-dots
 476     gnus-bbdb/canonicalize-spaces))
 477
 478 (defun gnus-bbdb/extract-address-components (str)
 479   (let* ((ret     (std11-extract-address-components str))
 480          (phrase  (car ret))
 481          (address (car (cdr ret)))
 482          (methods gnus-bbdb/canonicalize-full-name-methods))
 483     (while (and phrase methods)
 484       (setq phrase  (funcall (car methods) phrase)
 485             methods (cdr methods)))
 486     (if (string= address "") (setq address nil))
 487     (if (string= phrase "") (setq phrase nil))
 488     (when (or phrase address)
 489       (list phrase address))
 490     ))
 491
 492 ;;; @ full-name canonicalization methods
 493 ;;;
 494
 495 (defun gnus-bbdb/canonicalize-spaces (str)
 496   (let (dest)
 497     (while (string-match "\\s +" str)
 498       (setq dest (cons (substring str 0 (match-beginning 0)) dest))
 499       (setq str (substring str (match-end 0)))
 500       )
 501     (or (string= str "")
 502         (setq dest (cons str dest)))
 503     (setq dest (nreverse dest))
 504     (mapconcat 'identity dest " ")
 505     ))
 506
 507 (defun gnus-bbdb/canonicalize-dots (str)
 508   (let (dest)
 509     (while (string-match "\\." str)
 510       (setq dest (cons (substring str 0 (match-end 0)) dest))
 511       (setq str (substring str (match-end 0)))
 512       )
 513     (or (string= str "")
 514         (setq dest (cons str dest)))
 515     (setq dest (nreverse dest))
 516     (mapconcat 'identity dest " ")
 517     ))
 518
 519 ;;
 520 ;; Insinuation
 521 ;;
 522
 523 ;;;###autoload
 524 (defun gnus-bbdb-insinuate ()
 525   "Call this function to hook BBDB into Semi-gnus."
 526 ;;  (setq gnus-optional-headers 'gnus-bbdb/lines-and-from)
 527   (when (boundp 'bbdb-extract-field-value-function-list)
 528     (add-to-list 'bbdb-extract-field-value-function-list
 529                  'gnus-bbdb/extract-field-value-init))
 530   (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record)
 531   (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)
 532   (define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender)
 533   (define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes)
 534
 535   ;; Set up user field for use in gnus-summary-line-format
 536   (let ((get-author-user-fun (intern
 537                               (concat "gnus-user-format-function-"
 538                                       gnus-bbdb/summary-user-format-letter)))
 539         (in-bbdb-user-fun (intern
 540                            (concat "gnus-user-format-function-"
 541                                    gnus-bbdb/summary-in-bbdb-format-letter))))
 542                                         ; The big one - whole name
 543     (cond (gnus-bbdb/summary-user-format-letter
 544            (if (and (fboundp get-author-user-fun)
 545                     (not (eq (symbol-function get-author-user-fun)
 546                              'gnus-bbdb/summary-get-author)))
 547                (bbdb-warn
 548                 (format "`gnus-user-format-function-%s' already seems to be in use.
 549 Please redefine `gnus-bbdb/summary-user-format-letter' to a different letter."
 550                         gnus-bbdb/summary-user-format-letter))
 551              (fset get-author-user-fun 'gnus-bbdb/summary-get-author))))
 552
 553     ; One tick.  One tick only, please
 554     (cond (gnus-bbdb/summary-in-bbdb-format-letter
 555            (if (and (fboundp in-bbdb-user-fun)
 556                     (not (eq (symbol-function in-bbdb-user-fun)
 557                              'gnus-bbdb/summary-author-in-bbdb)))
 558                (bbdb-warn
 559                 (format "`gnus-user-format-function-%s' already seems to be in use.
 560 Redefine `gnus-bbdb/summary-in-bbdb-format-letter' to a different letter."
 561                         gnus-bbdb/summary-in-bbdb-format-letter))
 562              (fset in-bbdb-user-fun 'gnus-bbdb/summary-author-in-bbdb)))))
 563
 564   ;; Scoring
 565   (add-hook 'bbdb-after-change-hook 'gnus-bbdb/score-invalidate-alist)
 566 ;  (setq gnus-score-find-score-files-function
 567 ;       (if (boundp 'gnus-score-find-score-files-function)
 568 ;           (cond ((functionp gnus-score-find-score-files-function)
 569 ;                  (list gnus-score-find-score-files-function
 570 ;                        'gnus-bbdb/score))
 571 ;                 ((listp gnus-score-find-score-files-function)
 572 ;                  (append gnus-score-find-score-files-function
 573 ;                          'gnus-bbdb/score))
 574 ;                 (t 'gnus-bbdb/score))
 575 ;         'gnus-bbdb/score))
 576   )
 577
 578 ;;;###autoload
 579 (defun gnus-bbdb-insinuate-message ()
 580   "Call this function to hook BBDB into message-mode."
 581   (define-key message-mode-map "\M-\t" 'bbdb-complete-name))
 582
 583 (provide 'gnus-bbdb)