mu-bbdb.el

   1 ;;; mu-bbdb.el --- `attribution' function for mu-cite with BBDB.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   6 ;; Maintainer: Katsumi Yamaoka <yamaoka@jpl.org>
   7 ;; Keywords: mail, news, citation, bbdb
   8
   9 ;; This file is part of MU (Message Utilities).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;  - How to use
  29 ;;    1. bytecompile this file and copy it to the apropriate directory.
  30 ;;    2. put the following lines to your ~/.emacs:
  31 ;;             (add-hook 'mu-cite-load-hook
  32 ;;                       (function
  33 ;;                        (lambda ()
  34 ;;                          (require 'mu-bbdb)
  35 ;;                          )))
  36
  37 ;;; Code:
  38
  39 (eval-when-compile (require 'cl))
  40
  41 ;; Pickup `module-installed-p'.
  42 (require 'path-util)
  43
  44 (require 'mu-cite)
  45 (when (module-installed-p 'bbdb)
  46   (require 'bbdb))
  47
  48
  49 ;;; @ obsolete functions
  50 ;;;
  51
  52 ;; This part will be abolished in the near future.
  53
  54 (eval-and-compile
  55   (defconst mu-bbdb-obsolete-function-alist
  56     '((mu-cite/get-bbdb-attr            mu-bbdb-get-attr)
  57       (mu-cite/get-bbdb-prefix-method   mu-bbdb-get-prefix-method)
  58       (mu-cite/get-bbdb-prefix-register-method
  59        mu-bbdb-get-prefix-register-method)
  60       (mu-cite/get-bbdb-prefix-register-verbose-method
  61        mu-bbdb-get-prefix-register-verbose-method)
  62       (mu-cite/set-bbdb-attr            mu-bbdb-set-attr)))
  63
  64   (mapcar
  65    (function (lambda (elem)
  66                (apply (function define-obsolete-function-alias) elem)))
  67    mu-bbdb-obsolete-function-alist)
  68   )
  69
  70
  71 ;;; @ set up
  72 ;;;
  73
  74 (defgroup mu-bbdb nil
  75   "`attribution' function for mu-cite with BBDB."
  76   :prefix "mu-bbdb-"
  77   :group 'mu-cite
  78   :group 'bbdb)
  79
  80 (defcustom mu-bbdb-load-hook nil
  81   "List of functions called after mu-bbdb is loaded."
  82   :type 'hook
  83   :group 'mu-bbdb)
  84
  85 (defvar mu-bbdb-history nil)
  86
  87
  88 ;;; @@ prefix and registration using BBDB
  89 ;;;
  90
  91 (defun mu-bbdb-get-prefix-method ()
  92   (or (mu-bbdb-get-attr (mu-cite-get-value 'address))
  93       ">"))
  94
  95 (defun mu-bbdb-get-attr (addr)
  96   "Extract attribute information from BBDB."
  97   (let ((record (bbdb-search-simple nil addr)))
  98     (when record
  99       (bbdb-record-getprop record 'attribution))))
 100
 101 (defun mu-bbdb-set-attr (attr addr)
 102   "Add attribute information to BBDB."
 103   (let* ((bbdb-notice-hook nil)
 104          (record (bbdb-annotate-message-sender
 105                   addr t
 106                   (bbdb-invoke-hook-for-value
 107                    bbdb/mail-auto-create-p)
 108                   t)))
 109     (when record
 110       (bbdb-record-putprop record 'attribution attr)
 111       (bbdb-change-record record nil))))
 112
 113 (defun mu-bbdb-get-prefix-register-method ()
 114   (let ((addr (mu-cite-get-value 'address)))
 115     (or (mu-bbdb-get-attr addr)
 116         (let ((return
 117                (read-string "Citation name? "
 118                             (or (mu-cite-get-value 'x-attribution)
 119                                 (mu-cite-get-value 'full-name))
 120                             'mu-bbdb-history)))
 121           (if (and (not (string-equal return ""))
 122                    (y-or-n-p (format "Register \"%s\"? " return)))
 123               (mu-bbdb-set-attr return addr))
 124           return))))
 125
 126 (defun mu-bbdb-get-prefix-register-verbose-method ()
 127   (let* ((addr (mu-cite-get-value 'address))
 128          (attr (mu-bbdb-get-attr addr))
 129          (return (read-string "Citation name? "
 130                               (or attr
 131                                   (mu-cite-get-value 'x-attribution)
 132                                   (mu-cite-get-value 'full-name))
 133                               'mu-bbdb-history)))
 134     (if (and (not (string-equal return ""))
 135              (not (string-equal return attr))
 136              (y-or-n-p (format "Register \"%s\"? " return)))
 137         (mu-bbdb-set-attr return addr))
 138     return))
 139
 140 (unless (assoc 'bbdb-prefix mu-cite-default-methods-alist)
 141   (setq mu-cite-default-methods-alist
 142         (append mu-cite-default-methods-alist
 143                 (list
 144                  (cons 'bbdb-prefix
 145                        (function mu-bbdb-get-prefix-method))
 146                  (cons 'bbdb-prefix-register
 147                        (function mu-bbdb-get-prefix-register-method))
 148                  (cons 'bbdb-prefix-register-verbose
 149                        (function
 150                         mu-bbdb-get-prefix-register-verbose-method))))))
 151
 152
 153 ;;; @ end
 154 ;;;
 155
 156 (provide 'mu-bbdb)
 157
 158 (run-hooks 'mu-bbdb-load-hook)
 159
 160 ;;; mu-bbdb.el ends here