annotate lisp/net/eudcb-bbdb.el @ 48183:06be0e8df068

(set-buffer-file-coding-system): Call ucs-set-table-for-input.
author Dave Love <fx@gnu.org>
date Wed, 06 Nov 2002 23:34:58 +0000
parents 6d743d659035
children 0d8b17d428b5
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
42778
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
3 ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
42778
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
5 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
6d743d659035 New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents: 42574
diff changeset
6 ;; Maintainer: Pavel Janík <Pavel@Janik.cz>
42574
fcac9cd201ad Fix Keywords: header.
Pavel Janík <Pavel@Janik.cz>
parents: 42570
diff changeset
7 ;; Keywords: comm
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; any later version.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24 ;; Boston, MA 02111-1307, USA.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
27 ;; 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
28 ;; the Emacs Unified Directory Client.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 ;;; Code:
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 (require 'eudc)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33 (if (not (featurep 'bbdb))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 (load-library "bbdb"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 (if (not (featurep 'bbdb-com))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 (load-library "bbdb-com"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
38 ;;{{{ Internal cooking
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 ;; 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
41 ;; I don't want to use mapcar*
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 (defvar eudc-bbdb-current-query nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 (defvar eudc-bbdb-current-return-attributes nil)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 (defvar eudc-bbdb-attributes-translation-alist
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 '((name . lastname)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 (email . net)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 (phone . phones))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49 "Alist mapping EUDC attribute names to BBDB names.")
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51 (eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52 (eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53 (eudc-protocol-set 'eudc-protocol-attributes-translation-alist
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 'eudc-bbdb-attributes-translation-alist 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 (eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56 (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 (defun eudc-bbdb-format-query (query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 "Format a EUDC query alist into a list suitable to `bbdb-search'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 (let* ((firstname (cdr (assq 'firstname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 (lastname (cdr (assq 'lastname query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 (name (or (and firstname lastname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 (concat firstname " " lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 firstname
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 lastname))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 (company (cdr (assq 'company query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 (net (cdr (assq 'net query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 (notes (cdr (assq 'notes query)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (phone (cdr (assq 'phone query))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 (list name company net notes phone)))
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
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 (defun eudc-bbdb-filter-non-matching-record (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 (catch 'unmatch
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 (mapcar
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 (lambda (condition)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 (let ((attr (car condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (val (cdr condition))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 (case-fold-search t)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84 (or (and (memq attr '(firstname lastname aka company phones addresses net))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 (setq bbdb-val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (eval (list (intern (concat "bbdb-record-"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 'record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (if (listp bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 (eval `(or ,@(mapcar '(lambda (subval)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 (string-match val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 subval))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 (member (downcase val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 (mapcar 'downcase bbdb-val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 (if eudc-bbdb-enable-substring-matches
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (string-match val bbdb-val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (string-equal (downcase val) (downcase bbdb-val))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 (throw 'unmatch nil)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 eudc-bbdb-current-query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 (defun eudc-bbdb-extract-phones (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
106 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
107 (lambda (phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
108 (if eudc-bbdb-use-locations-as-attribute-names
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
109 (cons (intern (bbdb-phone-location phone))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110 (bbdb-phone-string phone))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
111 (cons 'phones (format "%s: %s"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 (bbdb-phone-location phone)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113 (bbdb-phone-string phone))))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114 (bbdb-record-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116 (defun eudc-bbdb-extract-addresses (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 (let (s c val)
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 (address)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 (setq val (concat (unless (= 0 (length (setq s (bbdb-address-street1 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 (concat s "\n"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 (progn
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127 (setq c (bbdb-address-city address))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 (setq s (bbdb-address-state address))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 (if (and (> (length c) 0) (> (length s) 0))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 (concat c ", " s " ")
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 (concat c " ")))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 (bbdb-address-zip-string address)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 (if eudc-bbdb-use-locations-as-attribute-names
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 (cons (intern (bbdb-address-location address)) val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135 (cons 'addresses (concat (bbdb-address-location address) "\n" val)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 (bbdb-record-addresses record))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 (defun eudc-bbdb-format-record-as-result (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 "Format the BBDB RECORD as a EUDC query result record.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 The record is filtered according to `eudc-bbdb-current-return-attributes'"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 (let ((attrs (or eudc-bbdb-current-return-attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 '(firstname lastname aka company phones addresses net notes)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 attr
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 eudc-rec
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 (while (prog1
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 (setq attr (car attrs))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 (setq attrs (cdr attrs)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (cond
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 ((eq attr 'phones)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (setq val (eudc-bbdb-extract-phones record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 ((eq attr 'addresses)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (setq val (eudc-bbdb-extract-addresses record)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 ((memq attr '(firstname lastname aka company net notes))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (setq val (eval
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 (list (intern
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 (concat "bbdb-record-"
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 (symbol-name attr)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 'record))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (t
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 (setq val "Unknown BBDB attribute")))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 (if val
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 (cond
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 ((memq attr '(phones addresses))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 (setq eudc-rec (append val eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 ((and (listp val)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 (= 1 (length val)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ((> (length val) 0)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 (setq eudc-rec (cons (cons attr val) eudc-rec)))
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 (error "Unexpected attribute value")))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 (nreverse eudc-rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 (defun eudc-bbdb-query-internal (query &optional return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 "Query BBDB with QUERY.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 BBDB attribute names.
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 RETURN-ATTRS is a list of attributes to return, defaulting to
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 `eudc-default-return-attributes'."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 (let ((eudc-bbdb-current-query query)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 (eudc-bbdb-current-return-attributes return-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (query-attrs (eudc-bbdb-format-query query))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 bbdb-attrs
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (records (bbdb-records))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 result
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 filtered)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 ;; 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
192 ;; call bbdb-search iteratively on the returned records for each of the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 ;; requested attributes
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 (while (and records (> (length query-attrs) 0))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (if (car query-attrs)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 (setq query-attrs (cdr query-attrs)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 (lambda (record)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 (setq filtered (eudc-filter-duplicate-attributes record))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 ;; If there were duplicate attributes reverse the order of the
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 ;; record so the unique attributes appear first
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (if (> (length filtered) 1)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 (setq filtered (mapcar (function
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (lambda (rec)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (reverse rec)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 filtered)))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 (setq result (append result filtered))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 (delq nil
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 (mapcar 'eudc-bbdb-format-record-as-result
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 (delq nil
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 (mapcar 'eudc-bbdb-filter-non-matching-record
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214 records)))))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 result))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
217 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 ;;{{{ High-level interfaces (interactive functions)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 (defun eudc-bbdb-set-server (dummy)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 "Set the EUDC server to BBDB."
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 (interactive)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224 (eudc-set-server dummy 'bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 (message "BBDB server selected"))
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226
42570
78a4068d960a Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents: 27313
diff changeset
227 ;;}}}
27313
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228
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 (eudc-register-protocol 'bbdb)
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 (provide 'eudcb-bbdb)
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233
babfd92e24bf *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 ;;; eudcb-bbdb.el ends here