File: mu-bbdb.el

package info (click to toggle)
mu-cite 8.1%2B0.20201103-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 212 kB
  • sloc: lisp: 874; makefile: 91; sh: 73
file content (130 lines) | stat: -rw-r--r-- 4,102 bytes parent folder | download | duplicates (8)
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
129
130
;;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, 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 'x-cite-me)
				  (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 'x-cite-me)
				   (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