mu-bbdb.el

   1 ;;; mu-bbdb.el --- registration feature of mu-cite using 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: BBDB, citation, mail, news
   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 (require 'mu-cite)
  40 (require 'bbdb)
  41
  42 (defvar mu-bbdb-load-hook nil
  43   "*List of functions called after mu-bbdb is loaded.")
  44
  45 (defvar mu-bbdb-history nil)
  46
  47
  48 ;;; @ prefix and registration using BBDB
  49 ;;;
  50
  51 (defun mu-cite/get-bbdb-prefix-method ()
  52   (or (mu-cite/get-bbdb-attr (mu-cite-get-value 'address))
  53       ">")
  54   )
  55
  56 (defun mu-cite/get-bbdb-attr (addr)
  57   "Extract attribute information from BBDB."
  58   (let ((record (bbdb-search-simple nil addr)))
  59     (and record
  60          (bbdb-record-getprop record 'attribution))
  61     ))
  62
  63 (defun mu-cite/set-bbdb-attr (attr addr)
  64   "Add attribute information to BBDB."
  65   (let* ((bbdb-notice-hook nil)
  66          (record (bbdb-annotate-message-sender
  67                   addr t
  68                   (bbdb-invoke-hook-for-value
  69                    bbdb/mail-auto-create-p)
  70                   t)))
  71     (if record
  72         (progn
  73           (bbdb-record-putprop record 'attribution attr)
  74           (bbdb-change-record record nil))
  75       )))
  76
  77 (defun mu-cite/get-bbdb-prefix-register-method ()
  78   (let ((addr (mu-cite-get-value 'address)))
  79     (or (mu-cite/get-bbdb-attr addr)
  80         (let ((return
  81                (read-string "Citation name? "
  82                             (or (mu-cite-get-value 'x-attribution)
  83                                 (mu-cite-get-value 'full-name))
  84                             'mu-bbdb-history)
  85                ))
  86           (if (and (not (string-equal return ""))
  87                    (y-or-n-p (format "Register \"%s\"? " return)))
  88               (mu-cite/set-bbdb-attr return addr)
  89             )
  90           return))))
  91
  92 (defun mu-cite/get-bbdb-prefix-register-verbose-method ()
  93   (let* ((addr (mu-cite-get-value 'address))
  94          (attr (mu-cite/get-bbdb-attr addr))
  95          (return (read-string "Citation name? "
  96                               (or attr
  97                                   (mu-cite-get-value 'x-attribution)
  98                                   (mu-cite-get-value 'full-name))
  99                               'mu-bbdb-history))
 100          )
 101     (if (and (not (string-equal return ""))
 102              (not (string-equal return attr))
 103              (y-or-n-p (format "Register \"%s\"? " return))
 104              )
 105         (mu-cite/set-bbdb-attr return addr)
 106       )
 107     return))
 108
 109 (or (assoc 'bbdb-prefix mu-cite/default-methods-alist)
 110     (setq mu-cite/default-methods-alist
 111           (append mu-cite/default-methods-alist
 112                   (list
 113                    (cons 'bbdb-prefix
 114                          (function mu-cite/get-bbdb-prefix-method))
 115                    (cons 'bbdb-prefix-register
 116                          (function mu-cite/get-bbdb-prefix-register-method))
 117                    (cons 'bbdb-prefix-register-verbose
 118                          (function
 119                           mu-cite/get-bbdb-prefix-register-verbose-method))
 120                    ))))
 121
 122
 123 ;;; @ end
 124 ;;;
 125
 126 (provide 'mu-bbdb)
 127
 128 (run-hooks 'mu-bbdb-load-hook)
 129
 130 ;;; mu-bbdb.el ends here