File: mu-bbdb.el

package info (click to toggle)
mu-cite 8.1-2
  • links: PTS
  • area: main
  • in suites: woody
  • size: 144 kB
  • ctags: 68
  • sloc: lisp: 724; makefile: 85; sh: 79
file content (128 lines) | stat: -rw-r--r-- 4,023 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
;;; mu-bbdb.el --- registration feature of mu-cite using BBDB

;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.

;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Maintainer: Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: BBDB, citation, mail, news

;; This file is part of MU (Message Utilities).

;; 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.

;;; Code:

(require 'mu-cite)
(require 'bbdb)

(defvar mu-bbdb-history nil)


;;; @ BBDB interface
;;;

(defun mu-bbdb-get-attr (addr)
  "Extract attribute information from BBDB."
  (let ((record (bbdb-search-simple nil addr)))
    (if record
	(bbdb-record-getprop record 'attribution))))

(defun mu-bbdb-set-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)))))


;;; @ methods
;;;

;;;###autoload
(defun mu-bbdb-get-prefix-method ()
  "A mu-cite method to return a prefix from BBDB or \">\".
If an `attribution' value is found in BBDB, the value is returned.
Otherwise \">\" is returned.

Notice that please use (mu-cite-get-value 'bbdb-prefix)
instead of call the function directly."
  (or (mu-bbdb-get-attr (mu-cite-get-value 'address))
      ">"))

;;;###autoload
(defun mu-bbdb-get-prefix-register-method ()
  "A mu-cite method to return a prefix from BBDB or register it.
If an `attribution' value is found in BBDB, the value is returned.
Otherwise the function requests a prefix from a user.  The prefix will
be registered to BBDB if the user wants it.

Notice that please use (mu-cite-get-value 'bbdb-prefix-register)
instead of call the function directly."
  (let ((addr (mu-cite-get-value 'address)))
    (or (mu-bbdb-get-attr addr)
	(let* ((minibuffer-allow-text-properties nil)
	       (return
		(mu-cite-remove-text-properties
		 (read-string "Citation name? "
			      (or (mu-cite-get-value 'x-attribution)
				  (mu-cite-get-value 'full-name))
			      'mu-bbdb-history))))
	  (if (and (not (string-equal return ""))
		   (y-or-n-p (format "Register \"%s\"? " return)))
	      (mu-bbdb-set-attr return addr))
	  return))))

;;;###autoload
(defun mu-bbdb-get-prefix-register-verbose-method ()
  "A mu-cite method to return a prefix using BBDB.

In this method, a user must specify a prefix unconditionally.  If an
`attribution' value is found in BBDB, the value is used as a initial
value to input the prefix.  The prefix will be registered to BBDB if
the user wants it.

Notice that please use (mu-cite-get-value 'bbdb-prefix-register-verbose)
instead of call the function directly."
  (let* ((addr (mu-cite-get-value 'address))
	 (attr (mu-bbdb-get-attr addr))
	 (minibuffer-allow-text-properties nil)
	 (return (mu-cite-remove-text-properties
		  (read-string "Citation name? "
			       (or attr
				   (mu-cite-get-value 'x-attribution)
				   (mu-cite-get-value 'full-name))
			       'mu-bbdb-history))))
    (if (and (not (string-equal return ""))
	     (not (string-equal return attr))
	     (y-or-n-p (format "Register \"%s\"? " return)))
	(mu-bbdb-set-attr return addr))
    return))


;;; @ end
;;;

(provide 'mu-bbdb)

(run-hooks 'mu-bbdb-load-hook)

;;; mu-bbdb.el ends here