-;;; eudc.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
+;;; eudc.el --- Emacs Unified Directory Client
-;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; This file is part of GNU Emacs.
(require 'wid-edit)
+(eval-when-compile (require 'cl-lib))
+
(eval-and-compile
(if (not (fboundp 'make-overlay))
(require 'overlay)))
;; 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."
;; 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)
((eq 'first method)
(setq result
(eudc-add-field-to-records (cons (car field)
- (eudc-cadr field))
+ (cadr field))
result)))
((eq 'concat method)
(setq result
(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
(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
format (cdr format)))
;; If the same attribute appears more than once, merge
;; the corresponding values
- (setq query-alist (nreverse query-alist))
(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))
(> (length servers) eudc-max-servers-to-query))
(setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
- (condition-case signal
+ (unwind-protect
(progn
(setq response
(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
;; Process response through eudc-inline-expansion-format
(while response
- (setq response-string (apply 'format
- (car eudc-inline-expansion-format)
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field (car response)))
- "")))
- (eudc-translate-attribute-list
- (cdr eudc-inline-expansion-format)))))
+ (setq response-string
+ (apply 'format
+ (car eudc-inline-expansion-format)
+ (mapcar (function
+ (lambda (field)
+ (or (cdr (assq field (car response)))
+ "")))
+ (eudc-translate-attribute-list
+ (cdr eudc-inline-expansion-format)))))
(if (> (length response-string) 0)
(setq response-strings
(cons response-string response-strings)))
(delete-region beg end)
(insert (mapconcat 'identity response-strings ", ")))
((eq eudc-multiple-match-handling-method 'abort)
- (error "There is more than one match for the query"))))
- (or (and (equal eudc-server eudc-former-server)
- (equal eudc-protocol eudc-former-protocol))
- (eudc-set-server eudc-former-server eudc-former-protocol t)))
- (error
- (or (and (equal eudc-server eudc-former-server)
- (equal eudc-protocol eudc-former-protocol))
- (eudc-set-server eudc-former-server eudc-former-protocol t))
- (signal (car signal) (cdr signal))))))
+ (error "There is more than one match for the query")))))
+ (or (and (equal eudc-server eudc-former-server)
+ (equal eudc-protocol eudc-former-protocol))
+ (eudc-set-server eudc-former-server eudc-former-protocol t)))))
;;;###autoload
(defun eudc-query-form (&optional get-fields-from-server)
(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