]> code.delx.au - gnu-emacs/blobdiff - lisp/net/eudc.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / eudc.el
index cf5d13fce88c991bc278b691fc3c94b518c16be1..22e48dbd3d3175ac6b32c8cf73fc978c2312e918 100644 (file)
@@ -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)))
 ;; 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
@@ -1144,7 +1146,7 @@ queries the server for the existing fields and displays a corresponding form."
 
 (defun eudc-menu ()
   (let (command)
-    (append '("Directory Search")
+    (append '("Directory Servers")
            (list
             (append
              '("Server")
@@ -1184,8 +1186,8 @@ queries the server for the existing fields and displays a corresponding form."
       (define-key
        global-map
        [menu-bar tools directory-search]
-       (cons "Directory Search"
-             (easy-menu-create-menu "Directory Search" (cdr (eudc-menu))))))
+       (cons "Directory Servers"
+             (easy-menu-create-menu "Directory Servers" (cdr (eudc-menu))))))
      ((fboundp 'easy-menu-add-item)
       (let ((menu (eudc-menu)))
        (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu)
@@ -1195,8 +1197,9 @@ queries the server for the existing fields and displays a corresponding form."
       (define-key
        global-map
        [menu-bar tools eudc]
-       (cons "Directory Search"
-             (easy-menu-create-keymaps "Directory Search" (cdr (eudc-menu))))))
+       (cons "Directory Servers"
+             (easy-menu-create-keymaps "Directory Servers"
+                                        (cdr (eudc-menu))))))
      (t
       (error "Unknown version of easymenu"))))
    ))
@@ -1229,7 +1232,7 @@ This does nothing except loading eudc by autoload side-effect."
 (cond
  ((not (featurep 'xemacs))
   (defvar eudc-tools-menu
-    (let ((map (make-sparse-keymap "Directory Search")))
+    (let ((map (make-sparse-keymap "Directory Servers")))
       (define-key map [phone]
        `(menu-item ,(purecopy "Get Phone") eudc-get-phone
                    :help ,(purecopy "Get the phone field of name from the directory server")))
@@ -1253,7 +1256,7 @@ This does nothing except loading eudc by autoload side-effect."
       map))
   (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu)))
  (t
-  (let ((menu  '("Directory Search"
+  (let ((menu  '("Directory Servers"
                 ["Load Hotlist of Servers" eudc-load-eudc t]
                 ["New Server" eudc-set-server t]
                 ["---" nil nil]
@@ -1277,8 +1280,8 @@ This does nothing except loading eudc by autoload side-effect."
            (define-key
              global-map
              [menu-bar tools eudc]
-             (cons "Directory Search"
-                   (easy-menu-create-keymaps "Directory Search"
+             (cons "Directory Servers"
+                   (easy-menu-create-keymaps "Directory Servers"
                                              (cdr menu)))))))))))
 
 ;;}}}