[Emacs-diffs] master 836dce6: EUDC: Enable lexical binding and do some cleanups

[Thomas Fitzsimmons]

branch: master
commit 836dce63c3274eaa84a26c09a5b6dcb1522dba98
Author: Stefan Monnier <address@hidden>
Commit: Thomas Fitzsimmons <address@hidden>

    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.
---
 lisp/net/eudc.el | 104 ++++++++++++++++++++++++-------------------------------
 1 file changed, 45 insertions(+), 59 deletions(-)

diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 8d1071a..98f70bd 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