From: Thomas Fitzsimmons Date: Fri, 11 Mar 2022 23:04:53 +0000 (-0500) Subject: EUDC: Support querying all servers X-Git-Tag: emacs-29.0.90~1931^2~1193 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0470a4a939772c4bd25123b15f5eadab41f8bee5;p=emacs.git EUDC: Support querying all servers * lisp/net/eudc.el (eudc-expand-try-all): New command. (eudc-expand-inline): Add `try-all-servers' optional argument. Update `eudc-query-with-words' call. (eudc-query-with-words): Add `try-all-servers' optional argument. Move response formatting into main query loop. Query next server if `try-all-servers' is non-nil. (eudc-tail-menu): Add "Expand Inline Query Trying All Servers" menu item. * doc/misc/eudc.texi (Installation): Recommend eudc-expand-try-all. (Emacs-only Configuration): Likewise. (Inline Query Expansion, Inline Query Expansion): Likewise. Document `eudc-expand-try-all'. * etc/NEWS (EUDC): Describe new 'eudc-expand-try-all' command. --- diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 7de0bdc1808..3b24dfb919c 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -192,9 +192,9 @@ email composition buffers (@pxref{Inline Query Expansion}) @lisp (with-eval-after-load "message" - (define-key message-mode-map [(control ?c) (tab)] 'eudc-expand-inline)) + (define-key message-mode-map [(control ?c) (tab)] 'eudc-expand-try-all)) (with-eval-after-load "sendmail" - (define-key mail-mode-map [(control ?c) (tab)] 'eudc-expand-inline)) + (define-key mail-mode-map [(control ?c) (tab)] 'eudc-expand-try-all)) @end lisp @menu @@ -281,11 +281,12 @@ LDAP: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt eudc-server-hotlist '(("" . bbdb) ("ldaps://ldap.gnu.org" . ldap))) @@ -337,11 +338,12 @@ configure EUDC for LDAP: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt 'eudc-server-hotlist '(("" . bbdb) ("ldaps://ldap.gnu.org" . ldap))) @@ -366,11 +368,12 @@ and the @file{.emacs} expressions become: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt 'eudc-server-hotlist '(("" . bbdb) ("" . ldap))) (setopt 'ldap-host-parameters-alist @@ -709,19 +712,33 @@ be passed to the program. @node Inline Query Expansion @section Inline Query Expansion -Inline query expansion is a powerful method to get completion from your -directory server. The most common usage is for expanding names to email -addresses in mail message buffers. The expansion is performed by the -command @kbd{M-x eudc-expand-inline} which is available from the -@samp{Expand Inline Query} menu item but can also be conveniently -bound to a key shortcut (@pxref{Installation}). The operation is -controlled by the variables @code{eudc-inline-expansion-format}, -@code{eudc-inline-query-format}, +Inline query expansion is a powerful method to get completion from +your directory servers. The most common usage is for expanding names +to email addresses in mail message buffers. The expansion is +performed by the command @kbd{M-x eudc-expand-try-all} which is +available from the @samp{Expand Inline Query Trying All Servers} menu +item but can also be conveniently bound to a key shortcut +(@pxref{Installation}). The operation is controlled by the variables +@code{eudc-inline-expansion-format}, @code{eudc-inline-query-format}, @code{eudc-expanding-overwrites-query} and @code{eudc-multiple-match-handling-method}. -If the query fails for a server, other servers may be tried successively -until one of them finds a match (@pxref{Multi-server Queries}). +If the query fails for a server, other servers may be tried +successively until one of them finds a match (@pxref{Multi-server +Queries}), or all servers can be tried and all matches returned. + +@deffn Command eudc-expand-try-all try-all-servers-p +Query some or all servers and expand the query string before point. +The query string consists of the buffer substring from the point back +to the preceding comma, colon or beginning of line. +@code{eudc-inline-query-format} controls how individual words are +mapped onto directory attribute names. After querying the server or +servers for the given string, the expansion specified by +@code{eudc-inline-expansion-format} is inserted in the buffer at +point. If multiple matches are available, a selection window is +displayed. If @var{try-all-servers-p} is non-@code{nil} then all +servers are queried. +@end deffn @deffn Command eudc-expand-inline save-query-as-kill-p Query the server and expand the query string before point. The query diff --git a/etc/NEWS b/etc/NEWS index cd3db07e6e3..faac1fbc916 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -638,6 +638,14 @@ Rename 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill' to reflect the actual behaviour of the customization variable. ++++ +*** New command 'eudc-expand-try-all'. +This command can be used in place of 'eudc-expand-inline'. It takes a +prefix argument that causes 'eudc-expand-try-all' to return matches +from all servers instead of just the matches from the first server to +return any. This is useful for example, if one wants to search LDAP +for a name that happens to match a contact in one's BBDB. + ** eww/shr +++ diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index dbba69d1108..98d0565c2f5 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -741,9 +741,18 @@ If none try N - 1 and so forth." (setq n (1- n))) formats)) +;;;###autoload +(defun eudc-expand-try-all (&optional try-all-servers) + "Wrap `eudc-expand-inline' with a prefix argument. +If TRY-ALL-SERVERS -- the prefix argument when called +interactively -- is non-nil, collect results from all servers. +If TRY-ALL-SERVERS is nil, do not try subsequent servers after +one server returns any match." + (interactive "P") + (eudc-expand-inline (not eudc-expansion-save-query-as-kill) try-all-servers)) ;;;###autoload -(defun eudc-expand-inline (&optional save-query-as-kill) +(defun eudc-expand-inline (&optional save-query-as-kill try-all-servers) "Query the directory server, and expand the query string before point. The query string consists of the buffer substring from the point back to the preceding comma, colon or beginning of line. @@ -765,7 +774,7 @@ see `eudc-inline-expansion-servers'." (point))) (query-words (split-string (buffer-substring-no-properties beg end) "[ \t]+")) - (response-strings (eudc-query-with-words query-words))) + (response-strings (eudc-query-with-words query-words try-all-servers))) (if (null response-strings) (error "No match") @@ -788,7 +797,7 @@ see `eudc-inline-expansion-servers'." (error "There is more than one match for the query")))))) ;;;###autoload -(defun eudc-query-with-words (query-words) +(defun eudc-query-with-words (query-words &optional try-all-servers) "Query the directory server, and return the matching responses. The variable `eudc-inline-query-format' controls how to associate the individual QUERY-WORDS with directory attribute names. @@ -796,7 +805,8 @@ After querying the server for the given string, the expansion specified by `eudc-inline-expansion-format' is applied to the matches before returning them.inserted in the buffer at point. Multiple servers can be tried with the same query until one finds a match, -see `eudc-inline-expansion-servers'." +see `eudc-inline-expansion-servers'. When TRY-ALL-SERVERS is non-nil, +keep collecting results from subsequent servers after the first match." (cond ((eq eudc-inline-expansion-servers 'current-server) (or eudc-server @@ -813,6 +823,7 @@ see `eudc-inline-expansion-servers'." (error "Wrong value for `eudc-inline-expansion-servers': %S" eudc-inline-expansion-servers))) (let* (query-formats + response-strings (eudc-former-server eudc-server) (eudc-former-protocol eudc-protocol) ;; Prepare the list of servers to query @@ -824,7 +835,7 @@ see `eudc-inline-expansion-servers'." (if eudc-server (cons (cons eudc-server eudc-protocol) (delete (cons eudc-server eudc-protocol) - (copy-sequence eudc-server-hotlist))) + (copy-sequence eudc-server-hotlist))) eudc-server-hotlist)) ((eq eudc-inline-expansion-servers 'current-server) (list (cons eudc-server eudc-protocol)))))) @@ -834,46 +845,49 @@ see `eudc-inline-expansion-servers'." (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) (unwind-protect - (let ((response - (catch 'found - ;; Loop on the servers - (dolist (server servers) - (eudc-set-server (car server) (cdr server) t) - - ;; Determine which formats apply in the query-format list - (setq query-formats - (or - (eudc-extract-n-word-formats eudc-inline-query-format - (length query-words)) - (if (null eudc-protocol-has-default-query-attributes) - '(name)))) - - ;; Loop on query-formats - (while query-formats - (let ((response - (eudc-query - (eudc-format-query query-words (car query-formats)) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format))))) - (if response - (throw 'found response))) - (setq query-formats (cdr query-formats)))) - ;; No more servers to try... no match found - nil)) - (response-strings '())) - - ;; Process response through eudc-inline-expansion-format - (dolist (r response) - (let ((response-string - (apply #'format - (car eudc-inline-expansion-format) - (mapcar (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)))) + (cl-flet + ((run-query + (query-formats) + (let ((response + (eudc-query + (eudc-format-query query-words (car query-formats)) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format))))) + (if response + ;; Process response through eudc-inline-expansion-format. + (dolist (r response) + (let ((response-string + (apply #'format + (car eudc-inline-expansion-format) + (mapcar + (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)) + (when (not try-all-servers) + (throw 'found nil)))))))) + (catch 'found + ;; Loop on the servers. + (dolist (server servers) + (eudc-set-server (car server) (cdr server) t) + + ;; Determine which formats apply in the query-format list. + (setq query-formats + (or + (eudc-extract-n-word-formats eudc-inline-query-format + (length query-words)) + (if (null eudc-protocol-has-default-query-attributes) + '(name)))) + + ;; Loop on query-formats. + (while query-formats + (run-query query-formats) + (setq query-formats (cdr query-formats)))) + ;; No more servers to try... no match found. + nil) response-strings) (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) @@ -1053,6 +1067,8 @@ queries the server for the existing fields and displays a corresponding form." `(["---" nil nil] ["Query with Form" eudc-query-form :help "Display a form to query the directory server"] + ["Expand Inline Query Trying All Servers" eudc-expand-try-all + :help "Query all directory servers and expand the query string before point"] ["Expand Inline Query" eudc-expand-inline :help "Query the directory server, and expand the query string before point"] ["Insert Record into BBDB" eudc-insert-record-at-point-into-bbdb