comparison lisp/net/eudcb-bbdb.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

49597:e88404e8f2cf

    (phone . phones))
  "Alist mapping EUDC attribute names to BBDB names.")

(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
(eudc-protocol-set 'eudc-protocol-attributes-translation-alist 
		   'eudc-bbdb-attributes-translation-alist 'bbdb)
(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)

(defun eudc-bbdb-format-query (query)

	(company (cdr (assq 'company query)))
	(net (cdr (assq 'net query)))
	(notes (cdr (assq 'notes query)))
	(phone (cdr (assq 'phone query))))
    (list name company net notes phone)))
	

(defun eudc-bbdb-filter-non-matching-record (record)
  "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
  (catch 'unmatch
    (progn
      (mapcar 
       (function 
	(lambda (condition)
	  (let ((attr (car condition))
		(val (cdr condition))
		(case-fold-search t)
		bbdb-val)
	    (or (and (memq attr '(firstname lastname aka company phones addresses net))
		     (progn 
		       (setq bbdb-val 
			     (eval (list (intern (concat "bbdb-record-" 
							 (symbol-name attr)))
					 'record)))
		       (if (listp bbdb-val)
			   (if eudc-bbdb-enable-substring-matches
			       (eval `(or ,@(mapcar '(lambda (subval)

  (mapcar (function
	   (lambda (phone)
	     (if eudc-bbdb-use-locations-as-attribute-names
		 (cons (intern (bbdb-phone-location phone))
		       (bbdb-phone-string phone))
	       (cons 'phones (format "%s: %s" 
				     (bbdb-phone-location phone)
				     (bbdb-phone-string phone))))))
	  (bbdb-record-phones record)))

(defun eudc-bbdb-extract-addresses (record)

				   (concat s "\n"))
				 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
				   (concat s "\n"))
				 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
				   (concat s "\n"))
				 (progn 
				   (setq c (bbdb-address-city address))
				   (setq s (bbdb-address-state address))
				   (if (and (> (length c) 0) (> (length s) 0))
				       (concat c ", " s " ")
				     (concat c " ")))

  (let ((attrs (or eudc-bbdb-current-return-attributes
		   '(firstname lastname aka company phones addresses net notes)))
	attr
	eudc-rec
	val)
    (while (prog1 
	       (setq attr (car attrs))
	     (setq attrs (cdr attrs)))
      (cond
       ((eq attr 'phones)
	(setq val (eudc-bbdb-extract-phones record)))
       ((eq attr 'addresses)
	(setq val (eudc-bbdb-extract-addresses record)))
       ((memq attr '(firstname lastname aka company net notes))
	(setq val (eval 
		   (list (intern 
			  (concat "bbdb-record-" 
				  (symbol-name attr)))
			 'record))))
       (t
	(setq val "Unknown BBDB attribute")))
      (if val
	(cond 
	 ((memq attr '(phones addresses))
	  (setq eudc-rec (append val eudc-rec)))
	 ((and (listp val)
	  (= 1 (length val)))
	  (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
	 ((> (length val) 0)
	  (setq eudc-rec (cons (cons attr val) eudc-rec)))
	 (t
	  (error "Unexpected attribute value")))))
    (nreverse eudc-rec)))
	


(defun eudc-bbdb-query-internal (query &optional return-attrs)
  "Query BBDB  with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 
BBDB attribute names.  
RETURN-ATTRS is a list of attributes to return, defaulting to 
`eudc-default-return-attributes'."

  (let ((eudc-bbdb-current-query query)
	(eudc-bbdb-current-return-attributes return-attrs)
	(query-attrs (eudc-bbdb-format-query query))

	     (lambda (record)
	       (setq filtered (eudc-filter-duplicate-attributes record))
	       ;; If there were duplicate attributes reverse the order of the
	       ;; record so the unique attributes appear first
	       (if (> (length filtered) 1)
		   (setq filtered (mapcar (function 
					   (lambda (rec)
					     (reverse rec)))
					  filtered)))
	       (setq result (append result filtered))))
	    (delq nil
		  (mapcar 'eudc-bbdb-format-record-as-result 
			  (delq nil 
				(mapcar 'eudc-bbdb-filter-non-matching-record 
					records)))))
    result))

;;}}}

49598:0d8b17d428b5

    (phone . phones))
  "Alist mapping EUDC attribute names to BBDB names.")

(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
		   'eudc-bbdb-attributes-translation-alist 'bbdb)
(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)

(defun eudc-bbdb-format-query (query)

	(company (cdr (assq 'company query)))
	(net (cdr (assq 'net query)))
	(notes (cdr (assq 'notes query)))
	(phone (cdr (assq 'phone query))))
    (list name company net notes phone)))


(defun eudc-bbdb-filter-non-matching-record (record)
  "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
  (catch 'unmatch
    (progn
      (mapcar
       (function
	(lambda (condition)
	  (let ((attr (car condition))
		(val (cdr condition))
		(case-fold-search t)
		bbdb-val)
	    (or (and (memq attr '(firstname lastname aka company phones addresses net))
		     (progn
		       (setq bbdb-val
			     (eval (list (intern (concat "bbdb-record-"
							 (symbol-name attr)))
					 'record)))
		       (if (listp bbdb-val)
			   (if eudc-bbdb-enable-substring-matches
			       (eval `(or ,@(mapcar '(lambda (subval)

  (mapcar (function
	   (lambda (phone)
	     (if eudc-bbdb-use-locations-as-attribute-names
		 (cons (intern (bbdb-phone-location phone))
		       (bbdb-phone-string phone))
	       (cons 'phones (format "%s: %s"
				     (bbdb-phone-location phone)
				     (bbdb-phone-string phone))))))
	  (bbdb-record-phones record)))

(defun eudc-bbdb-extract-addresses (record)

				   (concat s "\n"))
				 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
				   (concat s "\n"))
				 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
				   (concat s "\n"))
				 (progn
				   (setq c (bbdb-address-city address))
				   (setq s (bbdb-address-state address))
				   (if (and (> (length c) 0) (> (length s) 0))
				       (concat c ", " s " ")
				     (concat c " ")))

  (let ((attrs (or eudc-bbdb-current-return-attributes
		   '(firstname lastname aka company phones addresses net notes)))
	attr
	eudc-rec
	val)
    (while (prog1
	       (setq attr (car attrs))
	     (setq attrs (cdr attrs)))
      (cond
       ((eq attr 'phones)
	(setq val (eudc-bbdb-extract-phones record)))
       ((eq attr 'addresses)
	(setq val (eudc-bbdb-extract-addresses record)))
       ((memq attr '(firstname lastname aka company net notes))
	(setq val (eval
		   (list (intern
			  (concat "bbdb-record-"
				  (symbol-name attr)))
			 'record))))
       (t
	(setq val "Unknown BBDB attribute")))
      (if val
	(cond
	 ((memq attr '(phones addresses))
	  (setq eudc-rec (append val eudc-rec)))
	 ((and (listp val)
	  (= 1 (length val)))
	  (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
	 ((> (length val) 0)
	  (setq eudc-rec (cons (cons attr val) eudc-rec)))
	 (t
	  (error "Unexpected attribute value")))))
    (nreverse eudc-rec)))



(defun eudc-bbdb-query-internal (query &optional return-attrs)
  "Query BBDB  with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
BBDB attribute names.
RETURN-ATTRS is a list of attributes to return, defaulting to
`eudc-default-return-attributes'."

  (let ((eudc-bbdb-current-query query)
	(eudc-bbdb-current-return-attributes return-attrs)
	(query-attrs (eudc-bbdb-format-query query))

	     (lambda (record)
	       (setq filtered (eudc-filter-duplicate-attributes record))
	       ;; If there were duplicate attributes reverse the order of the
	       ;; record so the unique attributes appear first
	       (if (> (length filtered) 1)
		   (setq filtered (mapcar (function
					   (lambda (rec)
					     (reverse rec)))
					  filtered)))
	       (setq result (append result filtered))))
	    (delq nil
		  (mapcar 'eudc-bbdb-format-record-as-result
			  (delq nil
				(mapcar 'eudc-bbdb-filter-non-matching-record
					records)))))
    result))

;;}}}