From 9360bf2d0e57dc6bc857abc3db2308af5952747f Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 3 Jan 2024 14:13:17 +0100 Subject: [PATCH] Improve 'completing-read-multiple' This simplifies the implementation of crm.el, making it a thin wrapper around 'completing-read'. This obviates the need for bespoke commands such as 'crm-complete' and 'crm-completion-help', and allows us to remove incorrect code in minibuffer.el that tried to accommodate for both 'completing-read' and 'completing-read-multiple'. 'crm-complete-and-exit' is still required to get the right behavior. While we're at it, also add a command for changing 'crm-separator' interactively, and an indication of 'completing-read-multiple' in the *Completions* buffer mode line. * lisp/emacs-lisp/crm.el (crm-local-completion-map) (crm-local-must-match-map): No longer used, replace with obsolete aliases of 'completing-read-multiple-mode-map' in favor of third party code that uses these variables. (crm-completion-table, crm--current-element) (crm--completion-command, crm-completion-help) (crm-complete, crm-complete-word) (crm--choose-completion-string): No longer used, remove. (crm-complete-and-exit): Update. (read-string-matching-regexp): New local variable. (read-string-matching-try-exit) (crm-change-separator): New commands. (read-string-matching-mode-map) (completing-read-multiple-mode-map): New keymap variables. (read-string-matching-mode) (completing-read-multiple-mode) (completions-multi-mode): New minor modes. (read-string-matching, crm-completion-setup): New functions. (completing-read-multiple): Update. * lisp/minibuffer.el (minibuffer-sort-completions) (minibuffer-narrow-buffer-completions) (minibuffer--add-completions-predicate) (minibuffer-narrow-completions-to-current) (minibuffer-widen-completions) (completions-auto-update): Delegate completion boundaries calculation. * doc/lispref/minibuf.texi (Minibuffer Completion): Document c-r-m. * etc/NEWS: Announce 'crm-change-separator'. --- doc/lispref/minibuf.texi | 30 ++++ etc/NEWS | 7 + lisp/emacs-lisp/crm.el | 316 +++++++++++++++++---------------------- lisp/minibuffer.el | 24 ++- 4 files changed, 182 insertions(+), 195 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 27ebadc8ee3..b565d4f095b 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1254,6 +1254,36 @@ different function to completely override the normal behavior of @code{completing-read}. @end defvar +@defun completing-read-multiple +This function is like @code{completing-read}, except that it reads +multiple inputs at once, and returns them as a list of strings. The +user types (or completes) the inputs in the minibuffer, separating +them with strings that match @code{crm-separator}. When displaying +the completions list for @code{completing-read-multiple}, the mode +line of the @file{*Completions*} buffer includes the an indicator that +says @samp{Multi}. Hovering over that indicator with the mouse shows +help about the current input separator. +@end defun + +@defvar crm-separator +The value of this variable is a regular expression that matches +@code{completing-read-multiple} input separators. By default, this is +set to @samp{[ \t]*,[ \t]*}, which means that a comma, possibly +surrounded by spaces or tabs, separates +@code{completing-read-multiple} inputs. +@end defvar + +@deffn Command crm-change-separator +This command, bound to @kbd{C-x ,} in the minibuffer during +@code{completing-read-multiple}, changes the current input separator. +It prompts for a new separator regular expression, and sets the local +value of @code{crm-separator} to that regular expression. With a +prefix argument, this command also prompts for a replacement string +(that should match the new separator) and replaces all of the existing +separators in the minibuffer with that replacement string. +@end deffn + + @node Completion Commands @subsection Minibuffer Commands that Do Completion diff --git a/etc/NEWS b/etc/NEWS index 7e42ed68ae6..40bf5347ed9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -786,6 +786,13 @@ it reverses the current order. This global minor mode automatically updates the *Completions* buffer as you type in the minibuffer. ++++ +*** New command 'crm-change-separator'. +This command lets you change the separator that +'completing-read-multiple' uses to split your input to multiple +strings. 'completing-read-multiple' binds 'C-x ,' to +'crm-change-separator' in the minibuffer. + ** Pcomplete --- diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 253dfc6237a..164abb9997a 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -74,6 +74,10 @@ ;; 2000-04-10: ;; ;; first revamped version +;; +;; 2024-01-03: +;; +;; second revamped version ;;; Code: @@ -83,99 +87,6 @@ "Separator regexp used for separating strings in `completing-read-multiple'. It should be a regexp that does not match the list of completion candidates.") -(defvar-keymap crm-local-completion-map - :doc "Local keymap for minibuffer multiple input with completion. -Analog of `minibuffer-local-completion-map'." - :parent minibuffer-local-completion-map - " " #'crm-complete - " " #'crm-complete-word - " " #'crm-completion-help) - -(defvar-keymap crm-local-must-match-map - :doc "Local keymap for minibuffer multiple input with exact match completion. -Analog of `minibuffer-local-must-match-map' for crm." - ;; We'd want to have multiple inheritance here. - :parent minibuffer-local-must-match-map - " " #'crm-complete - " " #'crm-complete-word - " " #'crm-completion-help - " " #'crm-complete-and-exit) - -(defvar crm-completion-table nil - "An alist whose elements' cars are strings, or an obarray. -This is a table used for completion by `completing-read-multiple' and its -supporting functions.") - -;; this function evolved from a posting by Stefan Monnier -(defun crm--collection-fn (string predicate flag) - "Function used by `completing-read-multiple' to compute completion values. -The value of STRING is the string to be completed. - -The value of PREDICATE is a function to filter possible matches, or -nil if none. - -The value of FLAG is used to specify the type of completion operation. -A value of nil specifies `try-completion'. A value of t specifies -`all-completions'. A value of lambda specifies a test for an exact match. - -For more information on STRING, PREDICATE, and FLAG, see the Elisp -Reference sections on “Programmed Completion” and “Basic Completion -Functions”." - (let ((beg 0)) - (while (string-match crm-separator string beg) - (setq beg (match-end 0))) - (completion-table-with-context (substring string 0 beg) - crm-completion-table - (substring string beg) - predicate - flag))) - -(defun crm--current-element () - "Parse the minibuffer to find the current element. -Return the element's boundaries as (START . END)." - (let ((bob (minibuffer-prompt-end))) - (cons (save-excursion - (if (re-search-backward crm-separator bob t) - (match-end 0) - bob)) - (save-excursion - (if (re-search-forward crm-separator nil t) - (match-beginning 0) - (point-max)))))) - -(defmacro crm--completion-command (beg end &rest body) - "Run BODY with BEG and END bound to the current element's boundaries." - (declare (indent 2) (debug (sexp sexp body))) - `(let* ((crm--boundaries (crm--current-element)) - (,beg (car crm--boundaries)) - (,end (cdr crm--boundaries))) - ,@body)) - -(defun crm-completion-help () - "Display a list of possible completions of the current minibuffer element." - (interactive) - (crm--completion-command beg end - (minibuffer-completion-help beg end)) - nil) - -(defun crm-complete () - "Complete the current element. -If no characters can be completed, display a list of possible completions. - -Return t if the current element is now a valid match; otherwise return nil." - (interactive) - (crm--completion-command beg end - (completion-in-region beg end - minibuffer-completion-table - minibuffer-completion-predicate))) - -(defun crm-complete-word () - "Complete the current element at most a single word. -Like `minibuffer-complete-word' but for `completing-read-multiple'." - (interactive) - (crm--completion-command beg end - (completion-in-region--single-word beg end))) - (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. All elements in the minibuffer must match. If there is a mismatch, move point @@ -183,44 +94,126 @@ to the location of mismatch and do not exit. This function is modeled after `minibuffer-complete-and-exit'." (interactive) - (let ((doexit t)) - (goto-char (minibuffer-prompt-end)) + (let ((bob (minibuffer--completion-prompt-end)) + (doexit t)) + (goto-char bob) (while (and doexit - (crm--completion-command beg end - (let ((end (copy-marker end t))) - (goto-char end) - (setq doexit nil) - (completion-complete-and-exit beg end - (lambda () (setq doexit t))) - (goto-char end) - (not (eobp)))) + (let* ((beg (save-excursion + (if (re-search-backward crm-separator bob t) + (match-end 0) + bob))) + (end (copy-marker + (save-excursion + (if (re-search-forward crm-separator nil t) + (match-beginning 0) + (point-max))) + t))) + (goto-char end) + (setq doexit nil) + (completion-complete-and-exit beg end + (lambda () (setq doexit t))) + (goto-char end) + (not (eobp))) (looking-at crm-separator)) - ;; Skip to the next element. - (goto-char (match-end 0))) + (when doexit + (goto-char (match-end 0)))) (if doexit (exit-minibuffer)))) -(defun crm--choose-completion-string (choice buffer base-position - &rest _ignored) - "Completion string chooser for `completing-read-multiple'. -This is called from `choose-completion-string-functions'. -It replaces the string that is currently being completed, without -exiting the minibuffer." - (let ((completion-no-auto-exit t) - (choose-completion-string-functions nil)) - (choose-completion-string choice buffer base-position) - t)) - -;; superemulates behavior of completing_read in src/minibuf.c -;; Use \\ so that help-enable-autoload can -;; do its thing. Any keymap that is defined will do. +(defvar-local read-string-matching-regexp nil + "Regular expression that minibuffer input must match.") + +(defun read-string-matching-try-exit () + "Exit minibuffer only if the input matches `read-string-matching-regexp'." + (interactive nil minibuffer-mode) + (if (string-match-p read-string-matching-regexp (minibuffer-contents)) + (exit-minibuffer) + (user-error "Input does not match \"%s\"" read-string-matching-regexp))) + +(defvar-keymap read-string-matching-mode-map + :doc "Keymap for `read-string-matching-mode'." + " " #'read-string-matching-try-exit) + +(define-minor-mode read-string-matching-mode + "Minor mode for reading a string matching some regular expression. + +`read-string-matching' enables this minor mode in the minibuffer." + :lighter nil) + +(defun read-string-matching (regexp prompt &optional + initial-input history + default-value inherit-input-method) + "Read a string matching REGEXP in the minibufffer. + +This function calls `read-string' with arguments PROMPT, +INITIAL-INPUT, HISTORY, DEFAULT-VALUE and INHERIT-INPUT-METHOD." + (minibuffer-with-setup-hook + (lambda () + (read-string-matching-mode) + (setq read-string-matching-regexp regexp)) + (read-string prompt initial-input history default-value + inherit-input-method))) + +(defun crm-change-separator (sep &optional rep) + "Set the current `crm-separator' to SEP. + +Non-nil optional argument REP says to replace occurrences of the +old `crm-separator' in the current minibuffer contents with REP. + +Interactively, prompt for SEP. With a prefix argument, prompt +for REP as well." + (interactive + (let ((sep (read-regexp (format-prompt "New separator" crm-separator) + crm-separator))) + (list sep + (when current-prefix-arg + (read-string-matching sep "Replace existing separators with: ")))) + minibuffer-mode) + (when rep + (goto-char (minibuffer-prompt-end)) + (while (re-search-forward crm-separator nil t) + (replace-match rep t t))) + (setq-local crm-separator sep)) + +(define-minor-mode completions-multi-mode + "Minor mode for reading multiple strings in the minibuffer." + :lighter (:eval + (propertize " Multi" 'help-echo + (concat + "Insert multiple inputs by separating them with \"" + (buffer-local-value 'crm-separator + completion-reference-buffer) + "\"")))) + +(defun crm-completion-setup () + "Enable `completions-multi-mode' in *Completions* buffer." + (with-current-buffer standard-output (completions-multi-mode))) + +(define-obsolete-variable-alias 'crm-local-completion-map + 'completing-read-multiple-mode-map "30.1") + +(define-obsolete-variable-alias 'crm-local-must-match-map + 'completing-read-multiple-mode-map "30.1") + +(defvar-keymap completing-read-multiple-mode-map + :doc "Keymap for `completing-read-multiple-mode'." + " " #'crm-complete-and-exit + "C-x ," #'crm-change-separator) + +(define-minor-mode completing-read-multiple-mode + "Minor mode for reading multiple strings in the minibuffer." + :lighter nil + (if completing-read-multiple-mode + (add-hook 'completion-setup-hook #'crm-completion-setup 10 t) + (remove-hook 'completion-setup-hook #'crm-completion-setup t))) + ;;;###autoload (defun completing-read-multiple (prompt table &optional predicate require-match initial-input hist def inherit-input-method) "Read multiple strings in the minibuffer, with completion. The arguments are the same as those of `completing-read'. -\\ +\\ Input multiple strings by separating each one with a string that matches the regexp `crm-separator'. For example, if the separator regexp is \",\", entering \"alice,bob,eve\" specifies the strings @@ -235,66 +228,29 @@ contents of the minibuffer are \"alice,bob,eve\" and point is between This function returns a list of the strings that were read, with empty strings removed." - (let* ((map (if require-match - crm-local-must-match-map - crm-local-completion-map)) - input) - (minibuffer-with-setup-hook - (lambda () - (add-hook 'choose-completion-string-functions - 'crm--choose-completion-string nil 'local) - (setq-local minibuffer-completion-table #'crm--collection-fn) - (setq-local minibuffer-completion-predicate predicate) - (setq-local completion-list-insert-choice-function - (lambda (start end choice) - (if (and (stringp start) (stringp end)) - (let* ((beg (save-excursion - (goto-char (minibuffer-prompt-end)) - (or (search-forward start nil t) - (search-forward-regexp crm-separator nil t) - (minibuffer-prompt-end)))) - (end (save-excursion - (goto-char (point-max)) - (or (search-backward end nil t) - (progn - (goto-char beg) - (search-forward-regexp crm-separator nil t)) - (point-max))))) - (completion--replace beg end choice)) - (completion--replace start end choice)))) - ;; see completing_read in src/minibuf.c - (setq-local minibuffer-completion-confirm - (unless (eq require-match t) require-match)) - (setq-local crm-completion-table table)) - (setq input (read-from-minibuffer - prompt initial-input map - nil hist def inherit-input-method))) - ;; If the user enters empty input, `read-from-minibuffer' - ;; returns the empty string, not DEF. - (when (and def (string-equal input "")) - (setq input (if (consp def) (car def) def))) - ;; Remove empty strings in the list of read strings. - (split-string input crm-separator t))) - -;; testing and debugging -;; (defun crm-init-test-environ () -;; "Set up some variables for testing." -;; (interactive) -;; (setq my-prompt "Prompt: ") -;; (setq my-table -;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") -;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") -;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") -;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") -;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") -;; )) -;; (setq my-separator ",")) - -;(completing-read-multiple my-prompt my-table) -;(completing-read-multiple my-prompt my-table nil t) -;(completing-read-multiple my-prompt my-table nil "match") -;(completing-read my-prompt my-table nil t) -;(completing-read my-prompt my-table nil "match") + (split-string + (minibuffer-with-setup-hook + #'completing-read-multiple-mode + (completing-read + prompt + (lambda (s p a) + (let ((beg 0)) + (while (string-match crm-separator s beg) + (setq beg (match-end 0))) + (pcase a + (`(boundaries . ,suffix) + (let ((bounds (completion-boundaries + (substring s beg) table p + (substring suffix 0 (string-match crm-separator suffix))))) + `(boundaries ,(+ (car bounds) beg) . ,(cdr bounds)))) + ('metadata (completion-metadata (substring s beg) table p)) + ('nil (let ((comp (complete-with-action a table (substring s beg) p))) + (if (stringp comp) + (concat (substring s 0 beg) comp) + comp))) + (_ (complete-with-action a table (substring s beg) p))))) + predicate require-match initial-input hist def inherit-input-method)) + crm-separator t)) (provide 'crm) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0189695463c..b2529d9595c 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2658,7 +2658,7 @@ current order instead." (setq-local minibuffer-completions-sort-function (or (completion-metadata-get (completion--field-metadata - (car (minibuffer--completion-boundaries))) + (minibuffer-prompt-end)) 'display-sort-function) (pcase completions-sort ('nil #'identity) @@ -2675,9 +2675,7 @@ current order instead." (read-multiple-choice "Sort order" minibuffer-completions-sort-orders nil nil minibuffer-read-sort-order-with-completion))))) - (when completion-auto-help - (let ((beg-end (minibuffer--completion-boundaries))) - (minibuffer-completion-help (car beg-end) (cdr beg-end))))) + (when completion-auto-help (minibuffer-completion-help))) (defun minibuffer-completion-help (&optional start end) "Display a list of possible completions of the current minibuffer contents." @@ -5150,9 +5148,7 @@ DESC is a string describing predicate PRED." (setq-local minibuffer-completion-predicate #'always)) (add-function :after-while (local 'minibuffer-completion-predicate) pred `((description . ,desc))) - (when completion-auto-help - (let ((beg-end (minibuffer--completion-boundaries))) - (minibuffer-completion-help (car beg-end) (cdr beg-end)))) + (when completion-auto-help (minibuffer-completion-help)) (when-let ((completions-buffer (get-buffer "*Completions*"))) (with-current-buffer completions-buffer (completions-narrow-mode)))) @@ -5176,13 +5172,14 @@ exclude matches to current input from completions list." (let* ((table (make-hash-table :test #'equal)) (beg-end (minibuffer--completion-boundaries)) (beg (car beg-end)) (end (cdr beg-end)) - (input (buffer-substring beg end)) + (start (minibuffer-prompt-end)) + (input (buffer-substring start (point-max))) (all (completion-all-completions input minibuffer-completion-table minibuffer-completion-predicate - (- (point) beg) - (completion--field-metadata beg))) + (- (point) start) + (completion--field-metadata start))) (last (last all))) (unless all (user-error "No matching completion candidates")) @@ -5244,9 +5241,7 @@ remove all current restrictions without prompting." (format-prompt "Remove completions restriction,s" (caar desc-pred-alist)) desc-pred-alist nil t nil nil (caar desc-pred-alist)))))) - (when completion-auto-help - (let ((beg-end (minibuffer--completion-boundaries))) - (minibuffer-completion-help (car beg-end) (cdr beg-end)))) + (when completion-auto-help (minibuffer-completion-help)) (when-let ((completions-buffer (and (not (minibuffer-narrow-completions-p)) (get-buffer "*Completions*")))) (with-current-buffer completions-buffer @@ -5534,8 +5529,7 @@ This applies to `completions-auto-update-mode', which see." (when (get-buffer-window "*Completions*" 0) (if completion-in-region-mode (completion-help-at-point) - (let ((beg-end (minibuffer--completion-boundaries))) - (minibuffer-completion-help (car beg-end) (cdr beg-end))))) + (minibuffer-completion-help))) (setq completions-auto-update-timer nil)) (defun completions-auto-update-start-timer () -- 2.39.2