annotate lisp/net/eudcb-bbdb.el @ 110003:336e4a38a76d

Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Tue, 24 Aug 2010 22:45:30 +0000
parents 1d1d5d9bd884
children 280c8ae2476d 376148b31b5e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1 ;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
74509
f7702c5f335d Update copyright years.
Glenn Morris <rgm@gnu.org>
parents: 68648
diff changeset
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
106815
1d1d5d9bd884 Add 2010 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 100908
diff changeset
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5
42778
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
6 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
7 ;; Maintainer: Pavel Janík <Pavel@Janik.cz>
42574
fcac9cd201ad Fix Keywords: header.
Pavel Janík <Pavel@Janik.cz>
parents: 42570
diff changeset
8 ;; Keywords: comm
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; This file is part of GNU Emacs.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11
94677
91e5880a36c1 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
94677
91e5880a36c1 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
14 ;; the Free Software Foundation, either version 3 of the License, or
91e5880a36c1 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
15 ;; (at your option) any later version.
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; GNU General Public License for more details.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
94677
91e5880a36c1 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;;; Commentary:
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
26 ;; This library provides an interface to use BBDB as a backend of
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 ;; the Emacs Unified Directory Client.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29 ;;; Code:
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31 (require 'eudc)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 (if (not (featurep 'bbdb))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33 (load-library "bbdb"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 (if (not (featurep 'bbdb-com))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 (load-library "bbdb-com"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37 ;;{{{ Internal cooking
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
38
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 ;; I don't like this but mapcar does not accept a parameter to the function and
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 ;; I don't want to use mapcar*
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 (defvar eudc-bbdb-current-query nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 (defvar eudc-bbdb-current-return-attributes nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44 (defvar eudc-bbdb-attributes-translation-alist
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 '((name . lastname)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 (email . net)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 (phone . phones))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 "Alist mapping EUDC attribute names to BBDB names.")
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50 (eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51 (eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
52 (eudc-protocol-set 'eudc-protocol-attributes-translation-alist
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53 'eudc-bbdb-attributes-translation-alist 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 (eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 (defun eudc-bbdb-format-query (query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 "Format a EUDC query alist into a list suitable to `bbdb-search'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 (let* ((firstname (cdr (assq 'firstname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 (lastname (cdr (assq 'lastname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 (name (or (and firstname lastname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 (concat firstname " " lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 firstname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 (company (cdr (assq 'company query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 (net (cdr (assq 'net query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 (notes (cdr (assq 'notes query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 (phone (cdr (assq 'phone query))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (list name company net notes phone)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
70
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 (defun eudc-bbdb-filter-non-matching-record (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 (catch 'unmatch
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 (progn
85228
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
76 (mapc
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
77 (function
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 (lambda (condition)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 (let ((attr (car condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 (val (cdr condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (case-fold-search t)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 (or (and (memq attr '(firstname lastname aka company phones addresses net))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
84 (progn
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
85 (setq bbdb-val
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
86 (eval (list (intern (concat "bbdb-record-"
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 'record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 (if (listp bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 (eval `(or ,@(mapcar '(lambda (subval)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 (string-match val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 subval))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 (member (downcase val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 (mapcar 'downcase bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 (string-match val bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (string-equal (downcase val) (downcase bbdb-val))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (throw 'unmatch nil)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 eudc-bbdb-current-query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103
86816
4a5a63e12e5a (bbdb-phone-location, bbdb-phone-string)
Glenn Morris <rgm@gnu.org>
parents: 85228
diff changeset
104 ;; External.
86843
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
105 (declare-function bbdb-phone-location "ext:bbdb" t) ; via bbdb-defstruct
86816
4a5a63e12e5a (bbdb-phone-location, bbdb-phone-string)
Glenn Morris <rgm@gnu.org>
parents: 85228
diff changeset
106 (declare-function bbdb-phone-string "ext:bbdb" (phone))
86843
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
107 (declare-function bbdb-record-phones "ext:bbdb" t) ; via bbdb-defstruct
87024
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
108 (declare-function bbdb-address-streets "ext:bbdb" t) ; via bbdb-defstruct
86843
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
109 (declare-function bbdb-address-city "ext:bbdb" t) ; via bbdb-defstruct
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
110 (declare-function bbdb-address-state "ext:bbdb" t) ; via bbdb-defstruct
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
111 (declare-function bbdb-address-zip "ext:bbdb" t) ; via bbdb-defstruct
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
112 (declare-function bbdb-address-location "ext:bbdb" t) ; via bbdb-defstruct
9e7d6c65162b (bbdb-phone-location, bbdb-record-phones)
Glenn Morris <rgm@gnu.org>
parents: 86816
diff changeset
113 (declare-function bbdb-record-addresses "ext:bbdb" t) ; via bbdb-defstruct
86816
4a5a63e12e5a (bbdb-phone-location, bbdb-phone-string)
Glenn Morris <rgm@gnu.org>
parents: 85228
diff changeset
114 (declare-function bbdb-records "ext:bbdb"
4a5a63e12e5a (bbdb-phone-location, bbdb-phone-string)
Glenn Morris <rgm@gnu.org>
parents: 85228
diff changeset
115 (&optional dont-check-disk already-in-db-buffer))
4a5a63e12e5a (bbdb-phone-location, bbdb-phone-string)
Glenn Morris <rgm@gnu.org>
parents: 85228
diff changeset
116
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 (defun eudc-bbdb-extract-phones (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 (lambda (phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 (if eudc-bbdb-use-locations-as-attribute-names
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 (cons (intern (bbdb-phone-location phone))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 (bbdb-phone-string phone))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
123 (cons 'phones (format "%s: %s"
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 (bbdb-phone-location phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 (bbdb-phone-string phone))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 (bbdb-record-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 (defun eudc-bbdb-extract-addresses (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 (let (s c val)
87024
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
130 (mapcar (lambda (address)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
131 (setq c (bbdb-address-streets address))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
132 (dotimes (n 3)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
133 (unless (zerop (length (setq s (nth n c))))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
134 (setq val (concat val s "\n"))))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
135 (setq c (bbdb-address-city address)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
136 s (bbdb-address-state address))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
137 (setq val (concat val
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
138 (if (and (> (length c) 0) (> (length s) 0))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
139 (concat c ", " s)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
140 c)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
141 " "
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
142 (bbdb-address-zip address)))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
143 (if eudc-bbdb-use-locations-as-attribute-names
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
144 (cons (intern (bbdb-address-location address)) val)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
145 (cons 'addresses (concat (bbdb-address-location address)
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
146 "\n" val))))
d63d925838d5 (bbdb-address-streets): Declare as a function.
Glenn Morris <rgm@gnu.org>
parents: 86843
diff changeset
147 (bbdb-record-addresses record))))
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (defun eudc-bbdb-format-record-as-result (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 "Format the BBDB RECORD as a EUDC query result record.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 The record is filtered according to `eudc-bbdb-current-return-attributes'"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 (let ((attrs (or eudc-bbdb-current-return-attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 '(firstname lastname aka company phones addresses net notes)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 attr
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 eudc-rec
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 val)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
157 (while (prog1
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 (setq attr (car attrs))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 (setq attrs (cdr attrs)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (cond
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 ((eq attr 'phones)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 (setq val (eudc-bbdb-extract-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 ((eq attr 'addresses)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 (setq val (eudc-bbdb-extract-addresses record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 ((memq attr '(firstname lastname aka company net notes))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
166 (setq val (eval
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
167 (list (intern
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
168 (concat "bbdb-record-"
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 'record))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 (t
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 (setq val "Unknown BBDB attribute")))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 (if val
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
174 (cond
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 ((memq attr '(phones addresses))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176 (setq eudc-rec (append val eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 ((and (listp val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 (= 1 (length val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 ((> (length val) 0)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 (setq eudc-rec (cons (cons attr val) eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 (t
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 (error "Unexpected attribute value")))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 (nreverse eudc-rec)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
185
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (defun eudc-bbdb-query-internal (query &optional return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 "Query BBDB with QUERY.
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
190 QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
191 BBDB attribute names.
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 42778
diff changeset
192 RETURN-ATTRS is a list of attributes to return, defaulting to
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 `eudc-default-return-attributes'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (let ((eudc-bbdb-current-query query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (eudc-bbdb-current-return-attributes return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (query-attrs (eudc-bbdb-format-query query))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 bbdb-attrs
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (records (bbdb-records))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 result
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 filtered)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 ;; BBDB ORs its query attributes while EUDC ANDs them, hence we need to
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 ;; call bbdb-search iteratively on the returned records for each of the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 ;; requested attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 (while (and records (> (length query-attrs) 0))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (if (car query-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 (setq query-attrs (cdr query-attrs)))
85228
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
210 (mapc (function
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
211 (lambda (record)
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
212 (setq filtered (eudc-filter-duplicate-attributes record))
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
213 ;; If there were duplicate attributes reverse the order of the
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
214 ;; record so the unique attributes appear first
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
215 (if (> (length filtered) 1)
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
216 (setq filtered (mapcar (function
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
217 (lambda (rec)
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
218 (reverse rec)))
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
219 filtered)))
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
220 (setq result (append result filtered))))
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
221 (delq nil
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
222 (mapcar 'eudc-bbdb-format-record-as-result
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
223 (delq nil
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
224 (mapcar 'eudc-bbdb-filter-non-matching-record
631c2c083474 (eudc-bbdb-filter-non-matching-record)
Glenn Morris <rgm@gnu.org>
parents: 78230
diff changeset
225 records)))))
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226 result))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
227
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
228 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 ;;{{{ High-level interfaces (interactive functions)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 (defun eudc-bbdb-set-server (dummy)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233 "Set the EUDC server to BBDB."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (interactive)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 (eudc-set-server dummy 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236 (message "BBDB server selected"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
238 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 (eudc-register-protocol 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 (provide 'eudcb-bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
245 ;; arch-tag: 38276208-75de-4dbc-ba6f-8db684c32e0a
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246 ;;; eudcb-bbdb.el ends here