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 'eword-decode-string
  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))
  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
 114 (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create)
 115   "Make the *BBDB* buffer be displayed along with the GNUS windows,
 116 displaying the record corresponding to the sender of the current message."
 117   (let ((bbdb-gag-messages t)
 118         (bbdb-use-pop-up nil)
 119         (bbdb-electric-p nil))
 120     (let ((record (gnus-bbdb/update-record offer-to-create))
 121           (bbdb-elided-display (bbdb-pop-up-elided-display))
 122           (b (current-buffer)))
 123       ;; display the bbdb buffer iff there is a record for this article.
 124       (cond (record
 125              (bbdb-pop-up-bbdb-buffer
 126               (function (lambda (w)
 127                           (let ((b (current-buffer)))
 128                             (set-buffer (window-buffer w))
 129                             (prog1 (or (eq major-mode 'mime-veiw-mode)
 130                                        (eq major-mode 'gnus-article-mode))
 131                                    (set-buffer b))))))
 132              (bbdb-display-records (list record)))
 133             (t
 134              (or bbdb-inside-electric-display
 135                  (not (get-buffer-window bbdb-buffer-name))
 136                  (let (w)
 137                    (delete-other-windows)
 138                    (if (assq 'article gnus-buffer-configuration)
 139                        (gnus-configure-windows 'article)
 140                      (gnus-configure-windows 'SelectArticle))
 141                    (if (setq w (get-buffer-window gnus-summary-buffer))
 142                        (select-window w))
 143                    ))))
 144       (set-buffer b)
 145       record)))
 146
 147 ;;
 148 ;; Announcing BBDB entries in the summary buffer
 149 ;;
 150
 151 (defcustom gnus-bbdb/lines-and-from-length 18
 152   "*The number of characters used to display From: info in Gnus, if you have
 153 set gnus-optional-headers to 'gnus-bbdb/lines-and-from."
 154   :group 'bbdb-mua-specific-gnus
 155   :type 'integer)
 156
 157 (defcustom gnus-bbdb/summary-mark-known-posters t
 158   "*If t, mark messages created by people with records in the BBDB.
 159 In GNUS, this marking will take place in the subject list (assuming
 160 `gnus-optional-headers' contains `gnus-bbdb/lines-and-from').  In Gnus, the
 161 marking will take place in the Summary buffer if the format code defined by
 162 `gnus-bbdb/summary-user-format-letter' is used in `gnus-summary-line-format'.
 163 This variable has no effect on the marking controlled by
 164 `gnus-bbdb/summary-in-bbdb-format-letter'."
 165   :group 'bbdb-mua-specific-gnus
 166   :type '(choice (const :tag "Mark known posters" t)
 167                  (const :tag "Do not mark known posters" nil)))
 168 (defvaralias 'gnus-bbdb/mark-known-posters
 169   'gnus-bbdb/summary-mark-known-posters)
 170
 171 (defcustom gnus-bbdb/summary-known-poster-mark "+"
 172   "This is the default character to prefix author names with if
 173 gnus-bbdb/summary-mark-known-posters is t.  If the poster's record has
 174 an entry in the field named by bbdb-message-marker-field, then that will
 175 be used instead."
 176   :group 'bbdb-mua-specific-gnus
 177   :type 'character)
 178
 179 (defcustom gnus-bbdb/summary-show-bbdb-names t
 180   "*If both this variable and `gnus-bbdb/summary-prefer-real-names' are true,
 181 then for messages from authors who are in your database, the name
 182 displayed will be the primary name in the database, rather than the
 183 one in the From line of the message.  This doesn't affect the names of
 184 people who aren't in the database, of course.  (`gnus-optional-headers'
 185 must be `gnus-bbdb/lines-and-from' for GNUS users.)"
 186   :group 'bbdb-mua-specific-gnus
 187   :type 'boolean)
 188 (defvaralias 'gnus-bbdb/header-show-bbdb-names
 189   'gnus-bbdb/summary-show-bbdb-names)
 190
 191 (defcustom gnus-bbdb/summary-prefer-bbdb-data t
 192   "If t, then for posters who are in our BBDB, replace the information
 193 provided in the From header with data from the BBDB."
 194   :group 'bbdb-mua-specific-gnus
 195   :type 'boolean)
 196
 197 (defcustom gnus-bbdb/summary-prefer-real-names t
 198   "If t, then display the poster's name from the BBDB if we have one,
 199 otherwise display his/her primary net address if we have one.  If it
 200 is set to the symbol bbdb, then real names will be used from the BBDB
 201 if present, otherwise the net address in the post will be used.  If
 202 gnus-bbdb/summary-prefer-bbdb-data is nil, then this has no effect.
 203 See `gnus-bbdb/lines-and-from' for GNUS users, or
 204 `gnus-bbdb/summary-user-format-letter' for Gnus users."
 205   :group 'bbdb-mua-specific-gnus
 206   :type '(choice (const :tag "Prefer real names" t)
 207                  (const :tag "Prefer network addresses" nil)))
 208 (defvaralias 'gnus-bbdb/header-prefer-real-names
 209   'gnus-bbdb/summary-prefer-real-names)
 210
 211 (defcustom gnus-bbdb/summary-user-format-letter "B"
 212   "This is the gnus-user-format-function- that will be used to insert
 213 the information from the BBDB in the summary buffer (using
 214 `gnus-bbdb/summary-get-author').  This format code is meant to replace
 215 codes that insert sender names or addresses (like %A or %n). Unless
 216 you've alread got other code using user format B, you might as well
 217 stick with the default.  Additionally, if the value of this variable
 218 is nil, no format function will be installed for
 219 `gnus-bbdb/summary-get-author'.  See also
 220 `gnus-bbdb/summary-in-bbdb-format-letter', which installs a format
 221 code for `gnus-bbdb/summary-author-in-bbdb'"
 222   :group 'bbdb-mua-specific-gnus
 223   :type 'character)
 224
 225 (defcustom gnus-bbdb/summary-in-bbdb-format-letter "b"
 226   "This is the gnus-user-format-function- that will be used to insert
 227 `gnus-bbdb/summary-known-poster-mark' (using
 228 `gnus-bbdb/summary-author-in-bbdb') if the poster is in the BBDB, and
 229 \" \" if not.  If the value of this variable is nil, no format code
 230 will be installed for `gnus-bbdb/summary-author-in-bbdb'.  See also
 231 `gnus-bbdb/summary-user-format-letter', which installs a format code
 232 for `gnus-bbdb/summary-get-author'."
 233   :group 'bbdb-mua-specific-gnus
 234   :type 'character)
 235
 236 (defcustom bbdb-message-marker-field 'mark-char
 237   "*The field whose value will be used to mark messages by this user in Gnus."
 238   :group 'bbdb-mua-specific-gnus
 239   :type 'symbol)
 240
 241 ;;;###autoload
 242 (defun gnus-bbdb/lines-and-from (header)
 243   "Useful as the value of gnus-optional-headers in *GNUS* (not Gnus).
 244 NOTE: This variable no longer seems to be present in Gnus.  It seems
 245 to have been replaced by `message-default-headers', which only takes
 246 strings.  In the future this should change."
 247   (let* ((length gnus-bbdb/lines-and-from-length)
 248          (lines (mail-header-lines header))
 249          (from (mail-header-from header))
 250          (data (and (or gnus-bbdb/summary-mark-known-posters
 251                         gnus-bbdb/summary-show-bbdb-names)
 252                     (condition-case ()
 253                         (gnus-bbdb/extract-address-components from)
 254                       (error nil))))
 255          (name (car data))
 256          (net (car (cdr data)))
 257          (record (and data
 258                       (bbdb-search-simple name
 259                        (if (and net bbdb-canonicalize-net-hook)
 260                            (bbdb-canonicalize-address net)
 261                          net))))
 262          string L)
 263
 264     (if (and record name (member (downcase name) (bbdb-record-net record)))
 265         ;; bogon!
 266         (setq record nil))
 267
 268     (setq name
 269           (or (and gnus-bbdb/summary-prefer-bbdb-data
 270                    (or (and gnus-bbdb/summary-prefer-real-names
 271                             (and record (bbdb-record-name record)))
 272                        (and record (bbdb-record-net record)
 273                             (nth 0 (bbdb-record-net record)))))
 274               (and gnus-bbdb/summary-prefer-real-names
 275                    (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb)
 276                             net)
 277                        name))
 278               net from "**UNKNOWN**"))
 279       ;; GNUS can't cope with extra square-brackets appearing in the summary.
 280       (if (and name (string-match "[][]" name))
 281           (progn (setq name (copy-sequence name))
 282                  (while (string-match "[][]" name)
 283                    (aset name (match-beginning 0) ? ))))
 284       (setq string (format "%s%3d:%s"
 285                            (if (and record gnus-bbdb/summary-mark-known-posters)
 286                                (or (bbdb-record-getprop
 287                                     record bbdb-message-marker-field)
 288                                    "*")
 289                              " ")
 290                            lines (or name from))
 291             L (length string))
 292       (cond ((> L length) (substring string 0 length))
 293             ((< L length) (concat string (make-string (- length L) ? )))
 294             (t string))))
 295
 296 (defun gnus-bbdb/summary-get-author (header)
 297   "Given a Gnus message header, returns the appropriate piece of
 298 information to identify the author in a Gnus summary line, depending on
 299 the settings of the various configuration variables.  See the
 300 documentation for the following variables for more details:
 301   `gnus-bbdb/summary-mark-known-posters'
 302   `gnus-bbdb/summary-known-poster-mark'
 303   `gnus-bbdb/summary-prefer-bbdb-data'
 304   `gnus-bbdb/summary-prefer-real-names'
 305 This function is meant to be used with the user function defined in
 306   `gnus-bbdb/summary-user-format-letter'"
 307   (let* ((from (mail-header-from header))
 308          (data (and gnus-bbdb/summary-show-bbdb-names
 309                     (condition-case ()
 310                         (gnus-bbdb/extract-address-components from)
 311                       (error nil))))
 312          (name (car data))
 313          (net (car (cdr data)))
 314          (record (and data
 315                       (bbdb-search-simple name
 316                        (if (and net bbdb-canonicalize-net-hook)
 317                            (bbdb-canonicalize-address net)
 318                          net)))))
 319     (if (and record name (member (downcase name) (bbdb-record-net record)))
 320         ;; bogon!
 321         (setq record nil))
 322     (setq name
 323           (or (and gnus-bbdb/summary-prefer-bbdb-data
 324                    (or (and gnus-bbdb/summary-prefer-real-names
 325                             (and record (bbdb-record-name record)))
 326                        (and record (bbdb-record-net record)
 327                             (nth 0 (bbdb-record-net record)))))
 328               (and gnus-bbdb/summary-prefer-real-names
 329                    (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb)
 330                             net)
 331                        name))
 332               net from "**UNKNOWN**"))
 333     (format "%s%s"
 334             (or (and record gnus-bbdb/summary-mark-known-posters
 335                      (or (bbdb-record-getprop
 336                           record bbdb-message-marker-field)
 337                          gnus-bbdb/summary-known-poster-mark))
 338                 " ")
 339             name)))
 340
 341 ;; DEBUG: (gnus-bbdb/summary-author-in-bbdb "From: simmonmt@acm.org")
 342 (defun gnus-bbdb/summary-author-in-bbdb (header)
 343   "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."
 344   (let* ((from (mail-header-from header))
 345          (data (condition-case ()
 346                    (gnus-bbdb/extract-address-components from)
 347                  (error nil)))
 348          (name (car data))
 349          (net (cadr data))
 350          record)
 351     (if (and data
 352              (setq record
 353                    (bbdb-search-simple
 354                     name (if (and net bbdb-canonicalize-net-hook)
 355                              (bbdb-canonicalize-address net)
 356                            net))))
 357         (or (bbdb-record-getprop
 358              record bbdb-message-marker-field)
 359             gnus-bbdb/summary-known-poster-mark) " ")))
 360
 361 ;;
 362 ;; Scoring
 363 ;;
 364
 365 (defcustom gnus-bbdb/score-field 'gnus-score
 366   "This variable contains the name of the BBDB field which should be
 367 checked for a score to add to the net addresses in the same record."
 368   :group 'bbdb-mua-specific-gnus-scoring
 369   :type 'symbol)
 370
 371 (defcustom gnus-bbdb/score-default nil
 372   "If this is set, then every net address in the BBDB that does not have
 373 an associated score field will be assigned this score.  A value of nil
 374 implies a default score of zero."
 375   :group 'bbdb-mua-specific-gnus-scoring
 376   :type '(choice (const :tag "Do not assign default score")
 377                  (integer :tag "Assign this default score" 0)))
 378
 379 (defvar gnus-bbdb/score-default-internal nil
 380   "Internal variable for detecting changes to
 381 `gnus-bbdb/score-default'.  You should not set this variable directly -
 382 set `gnus-bbdb/score-default' instead.")
 383
 384 (defvar gnus-bbdb/score-alist nil
 385   "The text version of the scoring structure returned by
 386 gnus-bbdb/score.  This is built automatically from the BBDB.")
 387
 388 (defvar gnus-bbdb/score-rebuild-alist t
 389   "Set to t to rebuild gnus-bbdb/score-alist on the next call to
 390 gnus-bbdb/score.  This will be set automatically if you change a BBDB
 391 record which contains a gnus-score field.")
 392
 393 (defun gnus-bbdb/score-invalidate-alist (rec)
 394   "This function is called through bbdb-after-change-hook, and sets
 395 gnus-bbdb/score-rebuild-alist to t if the changed record contains a
 396 gnus-score field."
 397   (if (bbdb-record-getprop rec gnus-bbdb/score-field)
 398       (setq gnus-bbdb/score-rebuild-alist t)))
 399
 400 ;;;###autoload
 401 (defun gnus-bbdb/score (group)
 402   "This returns a score alist for GNUS.  A score pair will be made for
 403 every member of the net field in records which also have a gnus-score
 404 field.  This allows the BBDB to serve as a supplemental global score
 405 file, with the advantage that it can keep up with multiple and changing
 406 addresses better than the traditionally static global scorefile."
 407   (list (list
 408    (condition-case nil
 409        (read (gnus-bbdb/score-as-text group))
 410      (error (setq gnus-bbdb/score-rebuild-alist t)
 411             (message "Problem building BBDB score table.")
 412             (ding) (sit-for 2)
 413             nil)))))
 414
 415 (defun gnus-bbdb/score-as-text (group)
 416   "Returns a SCORE file format string built from the BBDB."
 417   (cond ((or (cond ((/= (or gnus-bbdb/score-default 0)
 418                         (or gnus-bbdb/score-default-internal 0))
 419                     (setq gnus-bbdb/score-default-internal
 420                           gnus-bbdb/score-default)
 421                     t))
 422             (not gnus-bbdb/score-alist)
 423             gnus-bbdb/score-rebuild-alist)
 424     (setq gnus-bbdb/score-rebuild-alist nil)
 425     (setq gnus-bbdb/score-alist
 426           (concat "((touched nil) (\"from\"\n"
 427                   (mapconcat
 428                    (lambda (rec)
 429                      (let ((score (or (bbdb-record-getprop rec
 430                                                            gnus-bbdb/score-field)
 431                                       gnus-bbdb/score-default))
 432                            (net (bbdb-record-net rec)))
 433                        (if (not (and score net)) nil
 434                          (mapconcat
 435                           (lambda (addr)
 436                             (concat "(\"" addr "\" " score ")\n"))
 437                           net ""))))
 438                    (bbdb-records) "")
 439                   "))"))))
 440   gnus-bbdb/score-alist)
 441
 442 (defun gnus-bbdb/extract-field-value-init ()
 443   (when (or (and (eq (current-buffer) (get-buffer gnus-article-buffer))
 444                  (buffer-live-p gnus-original-article-buffer)
 445                  (set-buffer gnus-original-article-buffer))
 446             (eq (current-buffer) (get-buffer gnus-original-article-buffer)))
 447     (widen)
 448     (narrow-to-region (point-min)
 449                       (progn (goto-char (point-min))
 450                              (or (search-forward "\n\n" nil t)
 451                                  (error "message unexists"))
 452                              (- (point) 2)))
 453     'gnus-bbdb/extract-field-value))
 454
 455 (defun gnus-bbdb/extract-field-value (field-name)
 456   "Given the name of a field (like \"Subject\") this returns the value of
 457 that field in the current message, or nil.  This works whether you're in
 458 Semi-gnus, Rmail, or VM.  This works on multi-line fields, but if more than
 459 one field of the same name is present, only the last is returned.  It is
 460 expected that the current buffer has a message in it, and (point) is at the
 461 beginning of the message headers."
 462   ;; we can't special-case VM here to use its cache, because the cache has
 463   ;; divided real-names from addresses; the actual From: and Subject: fields
 464   ;; exist only in the message.
 465   (let (value)
 466     (when (setq value (mail-fetch-field field-name))
 467       (gnus-bbdb/decode-field-body value field-name))))
 468
 469 ;;; @ mail-extr
 470 ;;;
 471
 472 (defvar gnus-bbdb/canonicalize-full-name-methods
 473   '(gnus-bbdb/canonicalize-dots
 474     gnus-bbdb/canonicalize-spaces))
 475
 476 (defun gnus-bbdb/extract-address-components (str)
 477   (let* ((ret     (std11-extract-address-components str))
 478          (phrase  (car ret))
 479          (address (car (cdr ret)))
 480          (methods gnus-bbdb/canonicalize-full-name-methods))
 481     (while (and phrase methods)
 482       (setq phrase  (funcall (car methods) phrase)
 483             methods (cdr methods)))
 484     (if (string= address "") (setq address nil))
 485     (if (string= phrase "") (setq phrase nil))
 486     (when (or phrase address)
 487       (list phrase address))
 488     ))
 489
 490 ;;; @ full-name canonicalization methods
 491 ;;;
 492
 493 (defun gnus-bbdb/canonicalize-spaces (str)
 494   (let (dest)
 495     (while (string-match "\\s +" str)
 496       (setq dest (cons (substring str 0 (match-beginning 0)) dest))
 497       (setq str (substring str (match-end 0)))
 498       )
 499     (or (string= str "")
 500         (setq dest (cons str dest)))
 501     (setq dest (nreverse dest))
 502     (mapconcat 'identity dest " ")
 503     ))
 504
 505 (defun gnus-bbdb/canonicalize-dots (str)
 506   (let (dest)
 507     (while (string-match "\\." str)
 508       (setq dest (cons (substring str 0 (match-end 0)) dest))
 509       (setq str (substring str (match-end 0)))
 510       )
 511     (or (string= str "")
 512         (setq dest (cons str dest)))
 513     (setq dest (nreverse dest))
 514     (mapconcat 'identity dest " ")
 515     ))
 516
 517 ;;
 518 ;; Insinuation
 519 ;;
 520
 521 ;;;###autoload
 522 (defun gnus-bbdb-insinuate ()
 523   "Call this function to hook BBDB into Semi-gnus."
 524 ;;  (setq gnus-optional-headers 'gnus-bbdb/lines-and-from)
 525   (when (boundp 'bbdb-extract-field-value-function-list)
 526     (add-to-list 'bbdb-extract-field-value-function-list
 527                  'gnus-bbdb/extract-field-value-init))
 528   (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record)
 529   (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save)
 530   (define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender)
 531   (define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes)
 532
 533   ;; Set up user field for use in gnus-summary-line-format
 534   (let ((get-author-user-fun (intern
 535                               (concat "gnus-user-format-function-"
 536                                       gnus-bbdb/summary-user-format-letter)))
 537         (in-bbdb-user-fun (intern
 538                            (concat "gnus-user-format-function-"
 539                                    gnus-bbdb/summary-in-bbdb-format-letter))))
 540                                         ; The big one - whole name
 541     (cond (gnus-bbdb/summary-user-format-letter
 542            (if (and (fboundp get-author-user-fun)
 543                     (not (eq (symbol-function get-author-user-fun)
 544                              'gnus-bbdb/summary-get-author)))
 545                (bbdb-warn
 546                 (format "`gnus-user-format-function-%s' already seems to be in use.
 547 Please redefine `gnus-bbdb/summary-user-format-letter' to a different letter."
 548                         gnus-bbdb/summary-user-format-letter))
 549              (fset get-author-user-fun 'gnus-bbdb/summary-get-author))))
 550
 551     ; One tick.  One tick only, please
 552     (cond (gnus-bbdb/summary-in-bbdb-format-letter
 553            (if (and (fboundp in-bbdb-user-fun)
 554                     (not (eq (symbol-function in-bbdb-user-fun)
 555                              'gnus-bbdb/summary-author-in-bbdb)))
 556                (bbdb-warn
 557                 (format "`gnus-user-format-function-%s' already seems to be in use.
 558 Redefine `gnus-bbdb/summary-in-bbdb-format-letter' to a different letter."
 559                         gnus-bbdb/summary-in-bbdb-format-letter))
 560              (fset in-bbdb-user-fun 'gnus-bbdb/summary-author-in-bbdb)))))
 561
 562   ;; Scoring
 563   (add-hook 'bbdb-after-change-hook 'gnus-bbdb/score-invalidate-alist)
 564 ;  (setq gnus-score-find-score-files-function
 565 ;       (if (boundp 'gnus-score-find-score-files-function)
 566 ;           (cond ((functionp gnus-score-find-score-files-function)
 567 ;                  (list gnus-score-find-score-files-function
 568 ;                        'gnus-bbdb/score))
 569 ;                 ((listp gnus-score-find-score-files-function)
 570 ;                  (append gnus-score-find-score-files-function
 571 ;                          'gnus-bbdb/score))
 572 ;                 (t 'gnus-bbdb/score))
 573 ;         'gnus-bbdb/score))
 574   )
 575
 576 ;;;###autoload
 577 (defun gnus-bbdb-insinuate-message ()
 578   "Call this function to hook BBDB into message-mode."
 579   (define-key message-mode-map "\M-\t" 'bbdb-complete-name))
 580
 581 (provide 'gnus-bbdb)