From 18f744a706bd3897d877a1d3288d259160fd22cd Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 7 Jan 2024 20:48:40 +0100 Subject: [PATCH] Move buffer name completion to Lisp and add affixation function * lisp/minibuffer.el (minibuffer-narrow-buffer-completions): Update doc string. (buffers-except-current-if-switching,internal-complete-buffer-except) (internal-complete-buffer): Replace with... (completion-buffer-name-table): ...this. New function. (completion-buffer-name-affixation): New function. * src/minibuf.c (Fread_buffer): Use 'completion-buffer-name-table' instead of... (Finternal_complete_buffer): ...this. Remove. (syms_of_minibuf): Update. * doc/emacs/mini.texi (Completion Options): Mention buffer name annotations in the documentation of 'completions-detailed'. * etc/NEWS: Announce. --- doc/emacs/mini.texi | 5 ++- etc/NEWS | 10 ++++- lisp/minibuffer.el | 105 ++++++++++++++++++++++++++++++++------------ src/minibuf.c | 70 ++++------------------------- 4 files changed, 98 insertions(+), 92 deletions(-) diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index a2487f2e295..731e056864a 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -911,7 +911,10 @@ instance, the completions list for @kbd{C-h o} (@pxref{Name Help}) includes the first line of the doc string of each symbol, and says whether each symbol is a function or a variable (and so on). For file name completion, the extra details annotations include file modes, -sizes, modification times and ownership information. +sizes, modification times and ownership information. For buffer name +completion, the annotations show major mode and either the name of +file that the buffer is visiting or the name and status of the +buffer's process. @node Minibuffer History @section Minibuffer History diff --git a/etc/NEWS b/etc/NEWS index 7694f8b1acc..4a6a299882a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -760,7 +760,15 @@ defined in the metadata or in 'completions-sort'. *** File name completions can now provide detailed candidate annotations. With non-nil user option 'completions-detailed', Emacs now displays extra details about file name completion candidates in the -"*Completions*" buffer as completion annotations. +"*Completions*" buffer as completion annotations. This affects +commands that read a file name with completion, such as 'C-x C-f'. + ++++ +*** Buffer name completions can now provide detailed candidate annotations. +With non-nil user option 'completions-detailed', Emacs now displays +extra details about buffer name completion candidates in the +"*Completions*" buffer as completion annotations. This affects +commands that read a buffer name with completion, such as 'C-x b'. ** Pcomplete diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 65db5606e94..f225fd0548a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3833,8 +3833,8 @@ See `read-file-name' for the meaning of the arguments." (defun minibuffer-narrow-buffer-completions () "Restrict buffer name completions by candidate major mode. -Completion collection function `internal-complete-buffer' uses -this function as its `narrow-completions-function'." +`completion-buffer-name-table' uses this function as its +`narrow-completions-function'." (let* ((names (let* ((beg (minibuffer-prompt-end)) (end (point-max)) @@ -3881,35 +3881,82 @@ this function as its `narrow-completions-function'." (mode (intern (concat name "-mode")))) (cons (lambda (cand) - (eq mode (buffer-local-value 'major-mode (cdr cand)))) + (eq mode (buffer-local-value 'major-mode (get-buffer cand)))) (format "mode %s" (capitalize name))))) -(defun buffers-except-current-if-switching (string pred action) - "Perform completion ACTION on STRING subject to PRED. - -This is similar to `internal-complete-buffer', except that this -function excludes `read-buffer-to-switch-current-buffer' when -that variable is not nil." - (let* ((except (when read-buffer-to-switch-current-buffer - (buffer-name read-buffer-to-switch-current-buffer))) - (predicate - (if except - (lambda (name) - (and (or (not pred) (funcall pred name)) - (not (equal except (car (ensure-list name)))))) - pred))) - (internal-complete-buffer string predicate action))) - -(defun internal-complete-buffer-except (&optional buffer) - "Perform completion on all buffers excluding BUFFER. -BUFFER nil or omitted means use the current buffer. -Like `internal-complete-buffer', but removes BUFFER from the completion list." - (let ((except (if (stringp buffer) buffer (buffer-name buffer)))) - (apply-partially #'completion-table-with-predicate - #'internal-complete-buffer - (lambda (name) - (not (equal (if (consp name) (car name) name) except))) - nil))) +(defun completion-buffer-name-affixation (names) + "Return completion affixations for buffer name list NAMES." + (let ((max-name (seq-max (mapcar #'string-width names))) + (max-mode + (seq-max + (mapcar #'string-width + (mapcar #'symbol-name + (mapcar (apply-partially #'buffer-local-value + 'major-mode) + (mapcar #'get-buffer names))))))) + (mapcar + (lambda (name) + (let ((buf (get-buffer name))) + (list name + (concat (if (and (buffer-modified-p buf) + (buffer-file-name buf)) + (propertize "*" 'face 'completions-annotations) " ") + " ") + (propertize + (concat (propertize " " 'display `(space :align-to + ,(+ max-name 4))) + (capitalize + (string-replace + "-mode" "" + (symbol-name (buffer-local-value 'major-mode buf)))) + (if-let ((file-name (buffer-file-name buf))) + (concat (propertize " " 'display + `(space :align-to + ,(+ max-name max-mode 2))) + file-name) + (when-let ((proc (get-buffer-process buf))) + (concat (propertize " " 'display + `(space :align-to + ,(+ max-name max-mode 2))) + (format "%s (%s)" + (process-name proc) + (process-status proc)))))) + 'face 'completions-annotations)))) + names))) + +(defun completion-buffer-name-table (string pred action) + "Completion table for buffer names. + +See Info node `(elisp)Programmed Completion' for the meaning of +STRING, PRED and ACTION. + +When the value of variable `read-buffer-to-switch-current-buffer' +is a buffer, this function excludles that buffer from the list of +possible completions." + (if (eq action 'metadata) + `(metadata + (category . buffer) + (cycle-sort-function . identity) + (display-sort-function . identity) + (narrow-completions-function . minibuffer-narrow-buffer-completions) + ,@(when completions-detailed + '((affixation-function . completion-buffer-name-affixation)))) + (let* ((buffers (remove read-buffer-to-switch-current-buffer (buffer-list))) + (names (mapcar #'buffer-name buffers)) + (cands (all-completions string names pred)) + (nohid (seq-filter (lambda (cand) + (not (or (string-empty-p cand) + (eq (aref cand 0) ?\s)))) + cands))) + (complete-with-action + action (or (and (string-empty-p string) nohid) cands) + string pred)))) + +(define-obsolete-function-alias 'internal-complete-buffer-except + 'completion-buffer-name-table "30.1") + +(define-obsolete-function-alias 'internal-complete-buffer + 'completion-buffer-name-table "30.1") ;;; Old-style completion, used in Emacs-21 and Emacs-22. diff --git a/src/minibuf.c b/src/minibuf.c index 2b3013e23cb..c7e6b651086 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1480,14 +1480,14 @@ Optional second arg DEF is value to return if user enters an empty line, If DEF is a list of default values, return its first element. Optional third arg REQUIRE-MATCH has the same meaning as the REQUIRE-MATCH argument of `completing-read'. -Optional arg PREDICATE, if non-nil, is a function limiting the buffers that -can be considered. It will be called with each potential candidate, in -the form of either a string or a cons cell whose `car' is a string, and -should return non-nil to accept the candidate for completion, nil otherwise. -If `read-buffer-completion-ignore-case' is non-nil, completion ignores -case while reading the buffer name. -If `read-buffer-function' is non-nil, this works by calling it as a -function, instead of the usual behavior. */) +Optional arg PREDICATE, if non-nil, is a function limiting the buffers +that can be considered. It will be called with each potential +candidate, in the form of a string, and should return non-nil to +accept the candidate for completion, nil otherwise. If +`read-buffer-completion-ignore-case' is non-nil, completion ignores +case while reading the buffer name. If `read-buffer-function' is +non-nil, this works by calling it as a function, instead of the usual +behavior. */) (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match, Lisp_Object predicate) { @@ -1530,7 +1530,7 @@ function, instead of the usual behavior. */) CONSP (def) ? XCAR (def) : def); } - result = Fcompleting_read (prompt, intern ("buffers-except-current-if-switching"), + result = Fcompleting_read (prompt, intern ("completion-buffer-name-table"), predicate, require_match, Qnil, Qbuffer_name_history, def, Qnil); } @@ -2148,53 +2148,6 @@ the values STRING, PREDICATE and `lambda'. */) return Qt; } -DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, - doc: /* Perform completion on buffer names. -STRING and PREDICATE have the same meanings as in `try-completion', -`all-completions', and `test-completion'. - -If FLAG is nil, invoke `try-completion'; if it is t, invoke -`all-completions'; otherwise invoke `test-completion'. */) - (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag) -{ - if (NILP (flag)) - return Ftry_completion (string, Vbuffer_alist, predicate); - else if (EQ (flag, Qt)) - { - Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil); - if (SCHARS (string) > 0) - return res; - else - { /* Strip out internal buffers. */ - Lisp_Object bufs = res; - /* First, look for a non-internal buffer in `res'. */ - while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ') - bufs = XCDR (bufs); - if (NILP (bufs)) - return (list_length (res) == list_length (Vbuffer_alist) - /* If all bufs are internal don't strip them out. */ - ? res : bufs); - res = bufs; - while (CONSP (XCDR (bufs))) - if (SREF (XCAR (XCDR (bufs)), 0) == ' ') - XSETCDR (bufs, XCDR (XCDR (bufs))); - else - bufs = XCDR (bufs); - return res; - } - } - else if (EQ (flag, Qlambda)) - return Ftest_completion (string, Vbuffer_alist, predicate); - else if (EQ (flag, Qmetadata)) - return list4 (Qmetadata, - Fcons (Qcategory, Qbuffer), - Fcons (Qcycle_sort_function, Qidentity), - Fcons (Qnarrow_completions_function, - Qminibuffer_narrow_buffer_completions)); - else - return Qnil; -} - /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0, @@ -2322,10 +2275,6 @@ syms_of_minibuf (void) DEFSYM (Qcurrent_input_method, "current-input-method"); DEFSYM (Qactivate_input_method, "activate-input-method"); - DEFSYM (Qmetadata, "metadata"); - DEFSYM (Qcycle_sort_function, "cycle-sort-function"); - DEFSYM (Qnarrow_completions_function, "narrow-completions-function"); - DEFSYM (Qminibuffer_narrow_buffer_completions, "minibuffer-narrow-buffer-completions"); /* A frame parameter. */ DEFSYM (Qminibuffer_exit, "minibuffer-exit"); @@ -2533,7 +2482,6 @@ showing the *Completions* buffer, if any. */); defsubr (&Sread_string); defsubr (&Sread_command); defsubr (&Sread_variable); - defsubr (&Sinternal_complete_buffer); defsubr (&Sread_buffer); defsubr (&Sminibuffer_depth); defsubr (&Sminibuffer_prompt); -- 2.39.5