mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-11 08:30:45 -08:00
Code Issues Projects Releases Wiki Activity

choose-completion: Retain the suffix after completion boundary

Browse source 
* lisp/minibuffer.el (completion-base-suffix):
Remove as not optimal after all (bug#48356).
(completion--replace): Use insert-before-markers-and-inherit.
(minibuffer-completion-help): Don't set completion-base-affixes,
implement the same logic more optimally by local search and
querying for field boundaries.  Also fix the problem with
completion table, predicate and extra-props being looked up in the
wrong buffer.
(minibuffer-next-completion, minibuffer-choose-completion):
Don't bind completion-use-base-affixes anymore.

* lisp/simple.el (completion-base-affixes)
(completion-use-base-affixes): Remove.
(completion-list-insert-choice-function):
Don't pass them through anymore.
This commit is contained in:
Dmitry Gutov 2024-05-09 05:30:32 +03:00
parent 8bc4292673
commit ff3f17ca3c
2 changed files with 42 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

99
lisp/minibuffer.el
View file

@ -112,20 +112,6 @@ the closest directory separators."
(cons (or (cadr boundaries) 0) (cons (or (cadr boundaries) 0)
(or (cddr boundaries) (length suffix))))) (or (cddr boundaries) (length suffix)))))
(defun completion-base-suffix (start end collection predicate)
"Return suffix of completion of buffer text between START and END.
COLLECTION and PREDICATE are, respectively, the completion's
completion table and predicate, as in `completion-boundaries' (which see).
Value is a substring of buffer text between point and END. It is
the completion suffix that follows the completion boundary."
(let ((suffix (buffer-substring (point) end)))
(substring
suffix
(cdr (completion-boundaries (buffer-substring start (point))
collection
predicate
suffix)))))
(defun completion-metadata (string table pred) (defun completion-metadata (string table pred)
"Return the metadata of elements to complete at the end of STRING. "Return the metadata of elements to complete at the end of STRING.
This metadata is an alist. Currently understood keys are: This metadata is an alist. Currently understood keys are:
@ -1377,7 +1363,7 @@ Moves point to the end of the new text."
(setq newtext (substring newtext 0 (- suffix-len)))) (setq newtext (substring newtext 0 (- suffix-len))))
(goto-char beg) (goto-char beg)
(let ((length (- end beg))) ;Read `end' before we insert the text. (let ((length (- end beg))) ;Read `end' before we insert the text.
(insert-and-inherit newtext) (insert-before-markers-and-inherit newtext)
(delete-region (point) (+ (point) length))) (delete-region (point) (+ (point) length)))
(forward-char suffix-len))) (forward-char suffix-len)))
@ -2598,17 +2584,23 @@ The candidate will still be chosen by `choose-completion' unless
(base-size (or (cdr last) 0)) (base-size (or (cdr last) 0))
(prefix (unless (zerop base-size) (substring string 0 base-size))) (prefix (unless (zerop base-size) (substring string 0 base-size)))
(minibuffer-completion-base (substring string 0 base-size)) (minibuffer-completion-base (substring string 0 base-size))
(base-prefix (buffer-substring (minibuffer--completion-prompt-end) (ctable minibuffer-completion-table)
(+ start base-size))) (cpred minibuffer-completion-predicate)
(base-suffix (concat (completion-base-suffix start end (cprops completion-extra-properties)
minibuffer-completion-table (field-end
minibuffer-completion-predicate) (save-excursion
(buffer-substring end (point-max)))) (forward-char
(cdr (completion-boundaries (buffer-substring start (point))
ctable
cpred
(buffer-substring (point) end))))
(point-marker)))
(field-char (and (< field-end end) (char-after field-end)))
(all-md (completion--metadata (buffer-substring-no-properties (all-md (completion--metadata (buffer-substring-no-properties
start (point)) start (point))
base-size md base-size md
minibuffer-completion-table ctable
minibuffer-completion-predicate)) cpred))
(ann-fun (completion-metadata-get all-md 'annotation-function)) (ann-fun (completion-metadata-get all-md 'annotation-function))
(aff-fun (completion-metadata-get all-md 'affixation-function)) (aff-fun (completion-metadata-get all-md 'affixation-function))
(sort-fun (completion-metadata-get all-md 'display-sort-function)) (sort-fun (completion-metadata-get all-md 'display-sort-function))
@ -2687,38 +2679,31 @@ The candidate will still be chosen by `choose-completion' unless
(with-current-buffer standard-output (with-current-buffer standard-output
(setq-local completion-base-position (setq-local completion-base-position
(list (+ start base-size) (list (+ start base-size) field-end))
;; FIXME: We should pay attention to completion
;; boundaries here, but currently
;; completion-all-completions does not give us the
;; necessary information.
end))
(setq-local completion-base-affixes
(list base-prefix base-suffix))
(setq-local completion-list-insert-choice-function (setq-local completion-list-insert-choice-function
(let ((ctable minibuffer-completion-table)
(cpred minibuffer-completion-predicate)
(cprops completion-extra-properties))
(lambda (start end choice) (lambda (start end choice)
(if (and (stringp start) (stringp end)) (unless (or (zerop (length prefix))
(progn (equal prefix
(delete-minibuffer-contents) (buffer-substring-no-properties
(insert start choice) (max (point-min)
;; Keep point after completion before suffix (- start (length prefix)))
(save-excursion (insert start)))
(completion--merge-suffix (message "*Completions* out of date"))
choice (when (> (point) end)
(1- (length choice)) ;; Completion suffix has changed, have to adapt.
end)))) (setq end (+ end
(unless (or (zerop (length prefix)) (cdr (completion-boundaries
(equal prefix (concat prefix choice) ctable cpred
(buffer-substring-no-properties (buffer-substring end (point))))))
(max (point-min) ;; Stopped before some field boundary.
(- start (length prefix))) (when (> (point) end)
start))) (setq field-char (char-after end))))
(message "*Completions* out of date")) (when (and field-char
;; FIXME: Use `md' to do quoting&terminator here. (= (aref choice (1- (length choice)))
(completion--replace start end choice)) field-char))
(setq end (1+ end)))
;; FIXME: Use `md' to do quoting&terminator here.
(completion--replace start end choice)
(let* ((minibuffer-completion-table ctable) (let* ((minibuffer-completion-table ctable)
(minibuffer-completion-predicate cpred) (minibuffer-completion-predicate cpred)
(completion-extra-properties cprops) (completion-extra-properties cprops)
@ -2729,7 +2714,7 @@ The candidate will still be chosen by `choose-completion' unless
;; completion is not finished. ;; completion is not finished.
(completion--done result (completion--done result
(if (eq (car bounds) (length result)) (if (eq (car bounds) (length result))
'exact 'finished))))))) 'exact 'finished))))))
(display-completion-list completions nil group-fun))))) (display-completion-list completions nil group-fun)))))
nil))) nil)))
@ -4877,8 +4862,7 @@ insert the selected completion candidate to the minibuffer."
(next-line-completion (or n 1)) (next-line-completion (or n 1))
(next-completion (or n 1))) (next-completion (or n 1)))
(when auto-choose (when auto-choose
(let ((completion-use-base-affixes t) (let ((completion-auto-deselect nil))
(completion-auto-deselect nil))
(choose-completion nil t t)))))) (choose-completion nil t t))))))
(defun minibuffer-previous-completion (&optional n) (defun minibuffer-previous-completion (&optional n)
@ -4916,8 +4900,7 @@ If NO-QUIT is non-nil, insert the completion candidate at point to the
minibuffer, but don't quit the completions window." minibuffer, but don't quit the completions window."
(interactive "P") (interactive "P")
(with-minibuffer-completions-window (with-minibuffer-completions-window
(let ((completion-use-base-affixes t)) (choose-completion nil no-exit no-quit)))
(choose-completion nil no-exit no-quit))))
(defun minibuffer-choose-completion-or-exit (&optional no-exit no-quit) (defun minibuffer-choose-completion-or-exit (&optional no-exit no-quit)
"Choose the completion from the minibuffer or exit the minibuffer. "Choose the completion from the minibuffer or exit the minibuffer.

21
lisp/simple.el
View file

@ -9858,16 +9858,6 @@ Its value is a list of the form (START END) where START is the place
where the completion should be inserted and END (if non-nil) is the end where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.") of the text to replace. If END is nil, point is used instead.")
(defvar completion-base-affixes nil
"Base context of the text corresponding to the shown completions.
This variable is used in the *Completions* buffer.
Its value is a list of the form (PREFIX SUFFIX) where PREFIX is the text
before the place where completion should be inserted, and SUFFIX is the text
after the completion.")
(defvar completion-use-base-affixes nil
"Non-nil means to restore original prefix and suffix in the minibuffer.")
(defvar completion-list-insert-choice-function #'completion--replace (defvar completion-list-insert-choice-function #'completion--replace
"Function to use to insert the text chosen in *Completions*. "Function to use to insert the text chosen in *Completions*.
Called with three arguments (BEG END TEXT), it should replace the text Called with three arguments (BEG END TEXT), it should replace the text
@ -10128,7 +10118,6 @@ minibuffer, but don't quit the completions window."
(with-current-buffer (window-buffer (posn-window (event-start event))) (with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer) (let ((buffer completion-reference-buffer)
(base-position completion-base-position) (base-position completion-base-position)
(base-affixes completion-base-affixes)
(insert-function completion-list-insert-choice-function) (insert-function completion-list-insert-choice-function)
(completion-no-auto-exit (if no-exit t completion-no-auto-exit)) (completion-no-auto-exit (if no-exit t completion-no-auto-exit))
(choice (choice
@ -10161,13 +10150,7 @@ minibuffer, but don't quit the completions window."
(with-current-buffer buffer (with-current-buffer buffer
(choose-completion-string (choose-completion-string
choice buffer choice buffer
;; Don't allow affixes to replace the whole buffer when not (or base-position
;; in the minibuffer. Thus check for `completion-in-region-mode'
;; to ignore non-nil value of `completion-use-base-affixes' set by
;; `minibuffer-choose-completion'.
(or (and (not completion-in-region-mode)
completion-use-base-affixes base-affixes)
base-position
;; If all else fails, just guess. ;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice))) (list (choose-completion-guess-base-position choice)))
insert-function))))) insert-function)))))
@ -10323,11 +10306,9 @@ Called from `temp-buffer-show-hook'."
(buffer-substring (minibuffer-prompt-end) (point))))))) (buffer-substring (minibuffer-prompt-end) (point)))))))
(with-current-buffer standard-output (with-current-buffer standard-output
(let ((base-position completion-base-position) (let ((base-position completion-base-position)
(base-affixes completion-base-affixes)
(insert-fun completion-list-insert-choice-function)) (insert-fun completion-list-insert-choice-function))
(completion-list-mode) (completion-list-mode)
(setq-local completion-base-position base-position) (setq-local completion-base-position base-position)
(setq-local completion-base-affixes base-affixes)
(setq-local completion-list-insert-choice-function insert-fun)) (setq-local completion-list-insert-choice-function insert-fun))
(setq-local completion-reference-buffer mainbuf) (setq-local completion-reference-buffer mainbuf)
(if base-dir (setq default-directory base-dir)) (if base-dir (setq default-directory base-dir))