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 ;;; @ BBDB interface
  49 ;;;
  50
  51 (defun mu-bbdb-get-attr (addr)
  52   "Extract attribute information from BBDB."
  53   (let ((record (bbdb-search-simple nil addr)))
  54     (and record
  55          (bbdb-record-getprop record 'attribution))))
  56
  57 (defun mu-bbdb-set-attr (attr addr)
  58   "Add attribute information to BBDB."
  59   (let* ((bbdb-notice-hook nil)
  60          (record (bbdb-annotate-message-sender
  61                   addr t
  62                   (bbdb-invoke-hook-for-value
  63                    bbdb/mail-auto-create-p)
  64                   t)))
  65     (if record
  66         (progn
  67           (bbdb-record-putprop record 'attribution attr)
  68           (bbdb-change-record record nil)
  69           ))))
  70
  71
  72 ;;; @ methods
  73 ;;;
  74
  75 ;;;###autoload
  76 (defun mu-bbdb-get-prefix-method ()
  77   "A mu-cite method to return a prefix from BBDB or \">\".
  78 If an `attribution' value is found in BBDB, the value is returned.
  79 Otherwise \">\" is returned.
  80
  81 Notice that please use (mu-cite-get-value 'bbdb-prefix)
  82 instead of call the function directly."
  83   (or (mu-bbdb-get-attr (mu-cite-get-value 'address))
  84       ">"))
  85
  86 ;;;###autoload
  87 (defun mu-bbdb-get-prefix-register-method ()
  88   "A mu-cite method to return a prefix from BBDB or register it.
  89 If an `attribution' value is found in BBDB, the value is returned.
  90 Otherwise the function requests a prefix from a user.  The prefix will
  91 be registered to BBDB if the user wants it.
  92
  93 Notice that please use (mu-cite-get-value 'bbdb-prefix-register)
  94 instead of call the function directly."
  95   (let ((addr (mu-cite-get-value 'address)))
  96     (or (mu-bbdb-get-attr addr)
  97         (let ((return
  98                (read-string "Citation name? "
  99                             (or (mu-cite-get-value 'x-attribution)
 100                                 (mu-cite-get-value 'full-name))
 101                             'mu-bbdb-history)))
 102           (if (and (not (string-equal return ""))
 103                    (y-or-n-p (format "Register \"%s\"? " return)))
 104               (mu-bbdb-set-attr return addr))
 105           return))))
 106
 107 ;;;###autoload
 108 (defun mu-bbdb-get-prefix-register-verbose-method ()
 109   "A mu-cite method to return a prefix using BBDB.
 110
 111 In this method, a user must specify a prefix unconditionally.  If an
 112 `attribution' value is found in BBDB, the value is used as a initial
 113 value to input the prefix.  The prefix will be registered to BBDB if
 114 the user wants it.
 115
 116 Notice that please use (mu-cite-get-value 'bbdb-prefix-register-verbose)
 117 instead of call the function directly."
 118   (let* ((addr (mu-cite-get-value 'address))
 119          (attr (mu-bbdb-get-attr addr))
 120          (return (read-string "Citation name? "
 121                               (or attr
 122                                   (mu-cite-get-value 'x-attribution)
 123                                   (mu-cite-get-value 'full-name))
 124                               'mu-bbdb-history)))
 125     (if (and (not (string-equal return ""))
 126              (not (string-equal return attr))
 127              (y-or-n-p (format "Register \"%s\"? " return)))
 128         (mu-bbdb-set-attr return addr))
 129     return))
 130
 131
 132 ;;; @ end
 133 ;;;
 134
 135 (provide 'mu-bbdb)
 136
 137 (run-hooks 'mu-bbdb-load-hook)
 138
 139 ;;; mu-bbdb.el ends here