50 |
|
|
51 |
(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb) |
(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb) |
52 |
(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb) |
(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb) |
53 |
(eudc-protocol-set 'eudc-protocol-attributes-translation-alist |
(eudc-protocol-set 'eudc-protocol-attributes-translation-alist |
54 |
'eudc-bbdb-attributes-translation-alist 'bbdb) |
'eudc-bbdb-attributes-translation-alist 'bbdb) |
55 |
(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb) |
(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb) |
56 |
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb) |
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb) |
68 |
(notes (cdr (assq 'notes query))) |
(notes (cdr (assq 'notes query))) |
69 |
(phone (cdr (assq 'phone query)))) |
(phone (cdr (assq 'phone query)))) |
70 |
(list name company net notes phone))) |
(list name company net notes phone))) |
71 |
|
|
72 |
|
|
73 |
(defun eudc-bbdb-filter-non-matching-record (record) |
(defun eudc-bbdb-filter-non-matching-record (record) |
74 |
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise." |
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise." |
75 |
(catch 'unmatch |
(catch 'unmatch |
76 |
(progn |
(progn |
77 |
(mapcar |
(mapcar |
78 |
(function |
(function |
79 |
(lambda (condition) |
(lambda (condition) |
80 |
(let ((attr (car condition)) |
(let ((attr (car condition)) |
81 |
(val (cdr condition)) |
(val (cdr condition)) |
82 |
(case-fold-search t) |
(case-fold-search t) |
83 |
bbdb-val) |
bbdb-val) |
84 |
(or (and (memq attr '(firstname lastname aka company phones addresses net)) |
(or (and (memq attr '(firstname lastname aka company phones addresses net)) |
85 |
(progn |
(progn |
86 |
(setq bbdb-val |
(setq bbdb-val |
87 |
(eval (list (intern (concat "bbdb-record-" |
(eval (list (intern (concat "bbdb-record-" |
88 |
(symbol-name attr))) |
(symbol-name attr))) |
89 |
'record))) |
'record))) |
90 |
(if (listp bbdb-val) |
(if (listp bbdb-val) |
108 |
(if eudc-bbdb-use-locations-as-attribute-names |
(if eudc-bbdb-use-locations-as-attribute-names |
109 |
(cons (intern (bbdb-phone-location phone)) |
(cons (intern (bbdb-phone-location phone)) |
110 |
(bbdb-phone-string phone)) |
(bbdb-phone-string phone)) |
111 |
(cons 'phones (format "%s: %s" |
(cons 'phones (format "%s: %s" |
112 |
(bbdb-phone-location phone) |
(bbdb-phone-location phone) |
113 |
(bbdb-phone-string phone)))))) |
(bbdb-phone-string phone)))))) |
114 |
(bbdb-record-phones record))) |
(bbdb-record-phones record))) |
123 |
(concat s "\n")) |
(concat s "\n")) |
124 |
(unless (= 0 (length (setq s (bbdb-address-street3 address)))) |
(unless (= 0 (length (setq s (bbdb-address-street3 address)))) |
125 |
(concat s "\n")) |
(concat s "\n")) |
126 |
(progn |
(progn |
127 |
(setq c (bbdb-address-city address)) |
(setq c (bbdb-address-city address)) |
128 |
(setq s (bbdb-address-state address)) |
(setq s (bbdb-address-state address)) |
129 |
(if (and (> (length c) 0) (> (length s) 0)) |
(if (and (> (length c) 0) (> (length s) 0)) |
143 |
attr |
attr |
144 |
eudc-rec |
eudc-rec |
145 |
val) |
val) |
146 |
(while (prog1 |
(while (prog1 |
147 |
(setq attr (car attrs)) |
(setq attr (car attrs)) |
148 |
(setq attrs (cdr attrs))) |
(setq attrs (cdr attrs))) |
149 |
(cond |
(cond |
152 |
((eq attr 'addresses) |
((eq attr 'addresses) |
153 |
(setq val (eudc-bbdb-extract-addresses record))) |
(setq val (eudc-bbdb-extract-addresses record))) |
154 |
((memq attr '(firstname lastname aka company net notes)) |
((memq attr '(firstname lastname aka company net notes)) |
155 |
(setq val (eval |
(setq val (eval |
156 |
(list (intern |
(list (intern |
157 |
(concat "bbdb-record-" |
(concat "bbdb-record-" |
158 |
(symbol-name attr))) |
(symbol-name attr))) |
159 |
'record)))) |
'record)))) |
160 |
(t |
(t |
161 |
(setq val "Unknown BBDB attribute"))) |
(setq val "Unknown BBDB attribute"))) |
162 |
(if val |
(if val |
163 |
(cond |
(cond |
164 |
((memq attr '(phones addresses)) |
((memq attr '(phones addresses)) |
165 |
(setq eudc-rec (append val eudc-rec))) |
(setq eudc-rec (append val eudc-rec))) |
166 |
((and (listp val) |
((and (listp val) |
171 |
(t |
(t |
172 |
(error "Unexpected attribute value"))))) |
(error "Unexpected attribute value"))))) |
173 |
(nreverse eudc-rec))) |
(nreverse eudc-rec))) |
174 |
|
|
175 |
|
|
176 |
|
|
177 |
(defun eudc-bbdb-query-internal (query &optional return-attrs) |
(defun eudc-bbdb-query-internal (query &optional return-attrs) |
178 |
"Query BBDB with QUERY. |
"Query BBDB with QUERY. |
179 |
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid |
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid |
180 |
BBDB attribute names. |
BBDB attribute names. |
181 |
RETURN-ATTRS is a list of attributes to return, defaulting to |
RETURN-ATTRS is a list of attributes to return, defaulting to |
182 |
`eudc-default-return-attributes'." |
`eudc-default-return-attributes'." |
183 |
|
|
184 |
(let ((eudc-bbdb-current-query query) |
(let ((eudc-bbdb-current-query query) |
202 |
;; If there were duplicate attributes reverse the order of the |
;; If there were duplicate attributes reverse the order of the |
203 |
;; record so the unique attributes appear first |
;; record so the unique attributes appear first |
204 |
(if (> (length filtered) 1) |
(if (> (length filtered) 1) |
205 |
(setq filtered (mapcar (function |
(setq filtered (mapcar (function |
206 |
(lambda (rec) |
(lambda (rec) |
207 |
(reverse rec))) |
(reverse rec))) |
208 |
filtered))) |
filtered))) |
209 |
(setq result (append result filtered)))) |
(setq result (append result filtered)))) |
210 |
(delq nil |
(delq nil |
211 |
(mapcar 'eudc-bbdb-format-record-as-result |
(mapcar 'eudc-bbdb-format-record-as-result |
212 |
(delq nil |
(delq nil |
213 |
(mapcar 'eudc-bbdb-filter-non-matching-record |
(mapcar 'eudc-bbdb-filter-non-matching-record |
214 |
records))))) |
records))))) |
215 |
result)) |
result)) |
216 |
|
|