diff lisp/tl/mu-bbdb.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tl/mu-bbdb.el	Mon Aug 13 08:46:56 2007 +0200
@@ -0,0 +1,128 @@
+;;; mu-bbdb.el --- `attribution' function for mu-cite with BBDB.
+
+;; Copyright (C) 1996 Shuhei KOBAYASHI
+
+;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Version: $Id: mu-bbdb.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+
+;; This file is part of tl (Tiny Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;  - How to use
+;;    1. bytecompile this file and copy it to the apropriate directory.
+;;    2. put the following lines to your ~/.emacs:
+;;		(require 'tl-misc)
+;;		(call-after-loaded 'mu-cite
+;;				   (function
+;;				    (lambda ()
+;;				      (require 'mu-bbdb)
+;;				      )))
+
+
+;;; Code:
+
+(require 'mu-cite)
+(require 'bbdb)
+
+(defvar mu-bbdb-load-hook nil
+  "*List of functions called after mu-bbdb is loaded.")
+
+;;; @@ prefix and registration using BBDB
+;;;
+
+(defun mu-cite/get-bbdb-prefix-method ()
+  (or (mu-cite/get-bbdb-attr (mu-cite/get-value 'address))
+      ">")
+  )
+
+(defun mu-cite/get-bbdb-attr (addr)
+  "Extract attribute information from BBDB."
+  (let ((record (bbdb-search-simple nil addr)))
+    (and record
+         (bbdb-record-getprop record 'attribution))
+    ))
+
+(defun mu-cite/set-bbdb-attr (attr addr)
+  "Add attribute information to BBDB."
+  (let* ((bbdb-notice-hook nil)
+         (record (bbdb-annotate-message-sender 
+                  addr t
+	          (bbdb-invoke-hook-for-value 
+	           bbdb/mail-auto-create-p)
+		  t)))
+    (if record
+        (progn
+          (bbdb-record-putprop record 'attribution attr)
+          (bbdb-change-record record nil))
+      )))
+
+(defun mu-cite/get-bbdb-prefix-register-method ()
+  (let ((addr (mu-cite/get-value 'address)))
+    (or (mu-cite/get-bbdb-attr addr)
+    	(let ((return
+	       (read-string "Citation name? "
+			    (or (mu-cite/get-value 'x-attribution)
+				(mu-cite/get-value 'full-name))
+			    'mu-cite/minibuffer-history)
+	       ))
+	  (if (and (not (string-equal return ""))
+                   (y-or-n-p (format "Register \"%s\"? " return)))
+	      (mu-cite/set-bbdb-attr return addr)
+	    )
+	  return))))
+
+(defun mu-cite/get-bbdb-prefix-register-verbose-method ()
+  (let* ((addr (mu-cite/get-value 'address))
+         (attr (mu-cite/get-bbdb-attr addr))
+	 (return (read-string "Citation name? "
+			      (or attr
+				  (mu-cite/get-value 'x-attribution)
+				  (mu-cite/get-value 'full-name))
+			      'mu-cite/minibuffer-history))
+	 )
+    (if (and (not (string-equal return ""))
+             (not (string-equal return attr))
+	     (y-or-n-p (format "Register \"%s\"? " return))
+	     )
+	(mu-cite/set-bbdb-attr return addr)
+      )
+    return))
+
+(or (assoc 'bbdb-prefix mu-cite/default-methods-alist)
+    (setq mu-cite/default-methods-alist
+          (append mu-cite/default-methods-alist
+                  (list
+                   (cons 'bbdb-prefix
+                         (function mu-cite/get-bbdb-prefix-method))
+                   (cons 'bbdb-prefix-register
+                         (function mu-cite/get-bbdb-prefix-register-method))
+                   (cons 'bbdb-prefix-register-verbose
+                         (function
+                          mu-cite/get-bbdb-prefix-register-verbose-method))
+                   ))))
+
+
+;;; @ end
+;;;
+
+(provide 'mu-bbdb)
+
+(run-hooks 'mu-bbdb-load-hook)
+
+;;; mu-bbdb.el ends here