X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e427b55370b28f55e285ce0ee4328246eb7522ea..7c9e6254bbac949aa5493ab1741d2523a7d595b7:/lisp/net/eudc.el

diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index cf5d13fce8..867bea98e7 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,6 +1,6 @@
-;;; eudc.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
+;;; eudc.el --- Emacs Unified Directory Client
 
-;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
 ;;         Pavel Janík <Pavel@Janik.cz>
@@ -47,6 +47,8 @@
 
 (require 'wid-edit)
 
+(eval-when-compile (require 'cl-lib))
+
 (eval-and-compile
   (if (not (fboundp 'make-overlay))
       (require 'overlay)))
@@ -105,17 +107,17 @@
 ;; attribute name
 (defvar eudc-protocol-has-default-query-attributes nil)
 
-(defun eudc-cadr (obj)
-  (car (cdr obj)))
-
-(defun eudc-cdar (obj)
-  (cdr (car obj)))
-
-(defun eudc-caar (obj)
-  (car (car obj)))
+(defvar bbdb-version)
 
-(defun eudc-cdaar (obj)
-  (cdr (car (car obj))))
+(defun eudc--using-bbdb-3-or-newer-p ()
+  "Return non-nil if BBDB version is 3 or greater."
+  (or
+   ;; MELPA versions of BBDB may have a bad package version, but
+   ;; they're all version 3 or later.
+   (equal bbdb-version "@PACKAGE_VERSION@")
+   ;; Development versions of BBDB can have the format "X.YZ devo".
+   ;; Split the string just in case.
+   (version<= "3" (car (split-string bbdb-version)))))
 
 (defun eudc-plist-member (plist prop)
   "Return t if PROP has a value specified in PLIST."
@@ -555,10 +557,10 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
 
     ;; Search for multiple records
     (while (and rec
-		(not (listp (eudc-cdar rec))))
+		(not (listp (cdar rec))))
       (setq rec (cdr rec)))
 
-    (if (null (eudc-cdar rec))
+    (if (null (cdar rec))
 	(list record)			; No duplicate attrs in this record
       (mapc (function
 	     (lambda (field)
@@ -590,7 +592,7 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
 	     ((eq 'first method)
 	      (setq result
 		    (eudc-add-field-to-records (cons (car field)
-						     (eudc-cadr field))
+						     (cadr field))
 					       result)))
 	     ((eq 'concat method)
 	      (setq result
@@ -710,7 +712,7 @@ If ERROR is non-nil, report an error if there is none."
   (let ((result (eudc-query (list (cons 'name name)) '(email)))
 	email)
     (if (null (cdr result))
-	(setq email (eudc-cdaar result))
+	(setq email (cl-cdaar result))
       (error "Multiple match--use the query form"))
     (if error
 	(if email
@@ -728,7 +730,7 @@ If ERROR is non-nil, report an error if there is none."
   (let ((result (eudc-query (list (cons 'name name)) '(phone)))
 	phone)
     (if (null (cdr result))
-	(setq phone (eudc-cdaar result))
+	(setq phone (cl-cdaar result))
       (error "Multiple match--use the query form"))
     (if error
 	(if phone
@@ -765,8 +767,8 @@ otherwise a list of symbols is returned."
 	  ;; If the same attribute appears more than once, merge
 	  ;; the corresponding values
 	  (while query-alist
-	    (setq key (eudc-caar query-alist)
-		  val (eudc-cdar query-alist)
+	    (setq key (caar query-alist)
+		  val (cdar query-alist)
 		  cell (assq key query))
 	    (if cell
 		(setcdr cell (concat (cdr cell) " " val))
@@ -863,7 +865,7 @@ see `eudc-inline-expansion-servers'"
 		(catch 'found
 		  ;; Loop on the servers
 		  (while servers
-		    (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t)
+		    (eudc-set-server (caar servers) (cdar servers) t)
 
 		    ;; Determine which formats apply in the query-format list
 		    (setq query-formats
@@ -1047,14 +1049,14 @@ queries the server for the existing fields and displays a corresponding form."
 				 (point))
 		  (setq set-server-p t))
 		 ((and (eq (car sexp)  'setq)
-		       (eq (eudc-cadr sexp) 'eudc-server-hotlist))
+		       (eq (cadr sexp) 'eudc-server-hotlist))
 		  (delete-region (save-excursion
 				   (backward-sexp)
 				   (point))
 				 (point))
 		  (setq set-hotlist-p t))
 		 ((and (eq (car sexp)  'provide)
-		       (equal (eudc-cadr sexp) '(quote eudc-options-file)))
+		       (equal (cadr sexp) '(quote eudc-options-file)))
 		  (setq provide-p t)))
 	      (if (and provide-p
 		       set-hotlist-p