-;;; eudc.el --- Emacs Unified Directory Client
+;;; eudc.el --- Emacs Unified Directory Client -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
(require 'wid-edit)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(eval-and-compile
(if (not (fboundp 'make-overlay))
(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)
(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)
(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)
(let ((replacement))
(setq replacement
(completing-read "Multiple matches found; choose one: "
- (mapcar 'list choices)))
+ (mapcar #'list choices)))
(delete-region beg end)
(insert replacement)))
(if match
(cdr match)
(capitalize
- (mapconcat 'identity
+ (mapconcat #'identity
(split-string (symbol-name attribute) "_")
" ")))))
(progn
(eval (list (cdr match) val))
(insert "\n"))
- (mapcar
+ (mapc
(function
(lambda (val-elem)
(indent-to col)
(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)))))))
(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)))
(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
(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.
"[ \t]+"))
query-formats
response
- response-string
response-strings
(eudc-former-server eudc-server)
(eudc-former-protocol eudc-protocol)
(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))
(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)
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)
(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
"Quit")
(goto-char pt)
(use-local-map widget-keymap)
- (widget-setup))
+ (widget-setup)))
)
(defun eudc-bookmark-server (server protocol)
;;; 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