mu-bbdb.el

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