/[emacs]/emacs/lisp/net/eudcb-bbdb.el
ViewVC logotype

Diff of /emacs/lisp/net/eudcb-bbdb.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by pj, Wed Jan 16 08:10:15 2002 UTC revision 1.4.4.1 by miles, Fri Apr 4 06:20:30 2003 UTC
# Line 50  Line 50 
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)
# Line 68  Line 68 
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)
# Line 108  Line 108 
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)))
# Line 123  Line 123 
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))
# Line 143  The record is filtered according to `eud Line 143  The record is filtered according to `eud
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
# Line 152  The record is filtered according to `eud Line 152  The record is filtered according to `eud
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)
# Line 171  The record is filtered according to `eud Line 171  The record is filtered according to `eud
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)
# Line 202  RETURN-ATTRS is a list of attributes to Line 202  RETURN-ATTRS is a list of attributes to
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    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.4.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26