mu-bbdb.el

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