EUDC: Enable lexical binding and do some cleanups

* lisp/net/eudc.el: Enable lexical binding.
(cl-lib): Always require cl-lib, not only when byte compiling.
(eudc-mode-map): Set parent keymap within let form.
(eudc-update-local-variables): Use #' read syntax for function
argument to map function.
(eudc-select): Likewise.
(eudc-format-attribute-name-for-display): Likewise
(eudc-filter-duplicate-attributes): Likewise.
(eudc-format-query): Likewise.
(eudc-expand-inline): Likewise.
(eudc-query-form): Likewise.
(eudc-print-attribute-value): Use mapc instead of mapcar.
(eudc-filter-partial-records): Use cl-every.
(eudc-distribute-field-on-records): Use delete-dups to
simplify function.
(eudc-expand-inline): Replace while with dolist and let form.
(eudc-query-form): Set inhibit-read-only after switching
buffers.  Remove useless and call.
(eudc-load-eudc): Add a FIXME comment.

1 files changed, 45 insertions, 59 deletions

diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 8d1071af727..98f70bd1f7a 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,4 +1,4 @@
-;;; eudc.el --- Emacs Unified Directory Client
+;;; eudc.el --- Emacs Unified Directory Client  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
 
@@ -47,7 +47,7 @@
 
 (require 'wid-edit)
 
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
 
 (eval-and-compile
   (if (not (fboundp 'make-overlay))
@@ -68,6 +68,7 @@
 
 (defvar eudc-mode-map
   (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map widget-keymap)
     (define-key map "q" 'kill-current-buffer)
     (define-key map "x" 'kill-current-buffer)
     (define-key map "f" 'eudc-query-form)
@@ -75,7 +76,6 @@
     (define-key map "n" 'eudc-move-to-next-record)
     (define-key map "p" 'eudc-move-to-previous-record)
     map))
-(set-keymap-parent eudc-mode-map widget-keymap)
 
 (defvar mode-popup-menu)
 
@@ -314,7 +314,7 @@ accordingly. Otherwise it is set to its EUDC default binding"
 (defun eudc-update-local-variables ()
   "Update all EUDC variables according to their local settings."
   (interactive)
-  (mapcar 'eudc-update-variable eudc-local-vars))
+  (mapcar #'eudc-update-variable eudc-local-vars))
 
 (eudc-default-set 'eudc-query-function nil)
 (eudc-default-set 'eudc-list-attributes-function nil)
@@ -378,7 +378,7 @@ BEG and END delimit the text which is to be replaced."
   (let ((replacement))
    (setq replacement
          (completing-read "Multiple matches found; choose one: "
-                          (mapcar 'list choices)))
+                          (mapcar #'list choices)))
    (delete-region beg end)
    (insert replacement)))
 
@@ -415,7 +415,7 @@ underscore characters are replaced by spaces."
     (if match
         (cdr match)
       (capitalize
-       (mapconcat 'identity
+       (mapconcat #'identity
                   (split-string (symbol-name attribute) "_")
                   " ")))))
 
@@ -432,7 +432,7 @@ if any, is called to print the value in cdr of FIELD."
         (progn
           (eval (list (cdr match) val))
           (insert "\n"))
-      (mapcar
+      (mapc
        (function
         (lambda (val-elem)
           (indent-to col)
@@ -598,9 +598,10 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
               (setq result
                     (eudc-add-field-to-records (cons (car field)
                                                      (mapconcat
-                                                      'identity
+                                                      #'identity
                                                       (cdr field)
-                                                      "\n")) result)))
+                                                      "\n"))
+                                               result)))
              ((eq 'duplicate method)
               (setq result
                     (eudc-distribute-field-on-records field result)))))))
@@ -613,12 +614,9 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
         (mapcar
          (function
           (lambda (rec)
-            (if (eval (cons 'and
-                       (mapcar
-                        (function
-                         (lambda (attr)
-                           (consp (assq attr rec))))
-                        attrs)))
+            (if (cl-every (lambda (attr)
+                            (consp (assq attr rec)))
+                          attrs)
                 rec)))
          records)))
 
@@ -632,25 +630,14 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
 (defun eudc-distribute-field-on-records (field records)
   "Duplicate each individual record in RECORDS according to value of FIELD.
 Each copy is added a new field containing one of the values of FIELD."
-  (let (result
-        (values (cdr field)))
-    ;; Uniquify values first
-    (while values
-      (setcdr values (delete (car values) (cdr values)))
-      (setq values (cdr values)))
-    (mapc
-     (function
-      (lambda (value)
-        (let ((result-list (copy-sequence records)))
-          (setq result-list (eudc-add-field-to-records
-                             (cons (car field) value)
-                             result-list))
-          (setq result (append result-list result))
-                 )))
-            (cdr field))
+  (let (result)
+    (dolist (value (delete-dups (cdr field))) ;; Uniquify values first.
+      (setq result (nconc (eudc-add-field-to-records
+                           (cons (car field) value)
+                           records)
+                          result)))
     result))
 
-
 (define-derived-mode eudc-mode special-mode "EUDC"
   "Major mode used in buffers displaying the results of directory queries.
 There is no sense in calling this command from a buffer other than
@@ -776,8 +763,8 @@ otherwise a list of symbols is returned."
             (setq query-alist (cdr query-alist)))
           query)
       (if eudc-protocol-has-default-query-attributes
-          (mapconcat 'identity words " ")
-        (list (cons 'name (mapconcat 'identity words " ")))))))
+          (mapconcat #'identity words " ")
+        (list (cons 'name (mapconcat #'identity words " ")))))))
 
 (defun eudc-extract-n-word-formats (format-list n)
   "Extract a list of N-long formats from FORMAT-LIST.
@@ -836,7 +823,6 @@ see `eudc-inline-expansion-servers'"
                                     "[ \t]+"))
          query-formats
          response
-         response-string
          response-strings
          (eudc-former-server eudc-server)
          (eudc-former-protocol eudc-protocol)
@@ -894,20 +880,18 @@ see `eudc-inline-expansion-servers'"
               (error "No match")
 
             ;; 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)))))
-              (if (> (length response-string) 0)
-                  (setq response-strings
-                        (cons response-string response-strings)))
-              (setq response (cdr response)))
+            (dolist (r response)
+              (let ((response-string
+                     (apply #'format
+                            (car eudc-inline-expansion-format)
+                            (mapcar (function
+                                     (lambda (field)
+                                       (or (cdr (assq field r))
+                                           "")))
+                                    (eudc-translate-attribute-list
+                                     (cdr eudc-inline-expansion-format))))))
+                (if (> (length response-string) 0)
+                    (push response-string response-strings))))
 
             (if (or
                  (and replace (not eudc-expansion-overwrites-query))
@@ -923,7 +907,7 @@ see `eudc-inline-expansion-servers'"
               (eudc-select response-strings beg end))
              ((eq eudc-multiple-match-handling-method 'all)
               (delete-region beg end)
-              (insert (mapconcat 'identity response-strings ", ")))
+              (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)
@@ -943,10 +927,9 @@ queries the server for the existing fields and displays a corresponding form."
         prompts
         widget
         (width 0)
-        inhibit-read-only
         pt)
     (switch-to-buffer buffer)
-    (setq inhibit-read-only t)
+    (let ((inhibit-read-only t))
     (erase-buffer)
     (kill-all-local-variables)
     (make-local-variable 'eudc-form-widget-list)
@@ -960,11 +943,10 @@ queries the server for the existing fields and displays a corresponding form."
     (widget-insert "Protocol         : " (symbol-name eudc-protocol) "\n")
     ;; Build the list of prompts
     (setq prompts (if eudc-use-raw-directory-names
-                      (mapcar 'symbol-name (eudc-translate-attribute-list fields))
+                      (mapcar #'symbol-name (eudc-translate-attribute-list fields))
                     (mapcar (function
                              (lambda (field)
-                               (or (and (assq field eudc-user-attribute-names-alist)
-                                        (cdr (assq field eudc-user-attribute-names-alist)))
+                               (or (cdr (assq field eudc-user-attribute-names-alist))
                                    (capitalize (symbol-name field)))))
                             fields)))
     ;; Loop over prompt strings to find the longest one
@@ -1008,7 +990,7 @@ queries the server for the existing fields and displays a corresponding form."
                    "Quit")
     (goto-char pt)
     (use-local-map widget-keymap)
-    (widget-setup))
+    (widget-setup)))
   )
 
 (defun eudc-bookmark-server (server protocol)
@@ -1207,25 +1189,29 @@ queries the server for the existing fields and displays a corresponding form."
 
 ;;; Load time initializations :
 
-;;; Load the options file
+;; Load the options file
 (if (and (not noninteractive)
          (and (locate-library eudc-options-file)
               (progn (message "") t))   ; Remove mode line message
          (not (featurep 'eudc-options-file)))
     (load eudc-options-file))
 
-;;; Install the full menu
+;; Install the full menu
 (unless (featurep 'infodock)
   (eudc-install-menu))
 
 
-;;; The following installs a short menu for EUDC at XEmacs startup.
+;; The following installs a short menu for EUDC at XEmacs startup.
 
 ;;;###autoload
 (defun eudc-load-eudc ()
   "Load the Emacs Unified Directory Client.
 This does nothing except loading eudc by autoload side-effect."
   (interactive)
+  ;; FIXME: By convention, loading a file should "do nothing significant"
+  ;; since Emacs may occasionally load a file for "frivolous" reasons
+  ;; (e.g. to find a docstring), so having a function which just loads
+  ;; the file doesn't seem very useful.
   nil)
 
 ;;;###autoload