X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c8d2553bd424e45872a1fe4f94c8be291eea5dc1..d66e8f72483ef8c6d7aa1afd391075235b4f23d2:/lisp/net/eudc.el diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 54a41f02fb..867bea98e7 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1,9 +1,10 @@ -;;; 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 -;; Maintainer: Pavel Janík +;; Pavel Janík +;; Maintainer: Thomas Fitzsimmons ;; Keywords: comm ;; This file is part of GNU Emacs. @@ -46,6 +47,8 @@ (require 'wid-edit) +(eval-when-compile (require 'cl-lib)) + (eval-and-compile (if (not (fboundp 'make-overlay)) (require 'overlay))) @@ -104,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." @@ -554,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) @@ -589,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 @@ -709,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 @@ -727,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 @@ -763,10 +766,9 @@ otherwise a list of symbols is returned." 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)) @@ -857,13 +859,13 @@ see `eudc-inline-expansion-servers'" (> (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 @@ -893,14 +895,15 @@ see `eudc-inline-expansion-servers'" ;; 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))) @@ -922,15 +925,10 @@ see `eudc-inline-expansion-servers'" (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) @@ -1051,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