lisp/net/eudcb-bbdb.el

1 ;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
33 (require 'eudc)
34 (if (not (featurep 'bbdb))
35     (load-library "bbdb"))
36 (if (not (featurep 'bbdb-com))
37     (load-library "bbdb-com"))
43 (defvar eudc-bbdb-current-query nil)
44 (defvar eudc-bbdb-current-return-attributes nil)
46 (defvar eudc-bbdb-attributes-translation-alist
52 (eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
53 (eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
54 (eudc-protocol-set 'eudc-protocol-attributes-translation-alist
55 		   'eudc-bbdb-attributes-translation-alist 'bbdb)
56 (eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
57 (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
59 (defun eudc-bbdb-format-query (query)
60   "Format a EUDC query alist into a list suitable to `bbdb-search'."
61   (let* ((firstname (cdr (assq 'firstname query)))
62 	 (lastname (cdr (assq 'lastname query)))
67 	(company (cdr (assq 'company query)))
68 	(net (cdr (assq 'net query)))
69 	(notes (cdr (assq 'notes query)))
70 	(phone (cdr (assq 'phone query))))
74 (defun eudc-bbdb-filter-non-matching-record (record)
75   "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
84 		bbdb-val)
87 		       (setq bbdb-val
88 			     (eval (list (intern (concat "bbdb-record-"
91 		       (if (listp bbdb-val)
92 			   (if eudc-bbdb-enable-substring-matches
96 						  bbdb-val)))
98 				     (mapcar 'downcase bbdb-val)))
99 			 (if eudc-bbdb-enable-substring-matches
100 			     (string-match val bbdb-val)
101 			   (string-equal (downcase val) (downcase bbdb-val))))))
103        eudc-bbdb-current-query)
106 (defun eudc-bbdb-extract-phones (record)
109 	     (if eudc-bbdb-use-locations-as-attribute-names
110 		 (cons (intern (bbdb-phone-location phone))
111 		       (bbdb-phone-string phone))
112 	       (cons 'phones (format "%s: %s"
113 				     (bbdb-phone-location phone)
114 				     (bbdb-phone-string phone))))))
115 	  (bbdb-record-phones record)))
117 (defun eudc-bbdb-extract-addresses (record)
121 	       (setq val (concat (unless (= 0 (length (setq s (bbdb-address-street1 address))))
123 				 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
125 				 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
128 				   (setq c (bbdb-address-city address))
129 				   (setq s (bbdb-address-state address))
133 				 (bbdb-address-zip-string address)))
134 	       (if eudc-bbdb-use-locations-as-attribute-names
135 		   (cons (intern (bbdb-address-location address)) val)
136 		 (cons 'addresses (concat (bbdb-address-location address) "\n" val)))))
137 	    (bbdb-record-addresses record))))
139 (defun eudc-bbdb-format-record-as-result (record)
140   "Format the BBDB RECORD as a EUDC query result record.
141 The record is filtered according to `eudc-bbdb-current-return-attributes'"
142   (let ((attrs (or eudc-bbdb-current-return-attributes
145 	eudc-rec
152 	(setq val (eudc-bbdb-extract-phones record)))
154 	(setq val (eudc-bbdb-extract-addresses record)))
158 			  (concat "bbdb-record-"
166 	  (setq eudc-rec (append val eudc-rec)))
169 	  (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
171 	  (setq eudc-rec (cons (cons attr val) eudc-rec)))
174     (nreverse eudc-rec)))
178 (defun eudc-bbdb-query-internal (query &optional return-attrs)
183 `eudc-default-return-attributes'."
185   (let ((eudc-bbdb-current-query query)
186 	(eudc-bbdb-current-return-attributes return-attrs)
187 	(query-attrs (eudc-bbdb-format-query query))
188 	bbdb-attrs
189 	(records (bbdb-records))
192     ;; BBDB ORs its query attributes while EUDC ANDs them, hence we need to
193     ;; call bbdb-search iteratively on the returned records for each of the
195     (while (and records (> (length query-attrs) 0))
196       (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
197       (if (car query-attrs)
198 	  (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
199       (setq query-attrs (cdr query-attrs)))
202 	       (setq filtered (eudc-filter-duplicate-attributes record))
212 		  (mapcar 'eudc-bbdb-format-record-as-result
214 				(mapcar 'eudc-bbdb-filter-non-matching-record
222 (defun eudc-bbdb-set-server (dummy)
225   (eudc-set-server dummy 'bbdb)
231 (eudc-register-protocol 'bbdb)
233 (provide 'eudcb-bbdb)
236 ;;; eudcb-bbdb.el ends here