From cdc7ce4b9958a0ef36e911066ecce82a6da09c02 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 16 Sep 2024 15:15:57 -0400 Subject: [PATCH] Add ignore-after-point completion style * lisp/minibuffer.el (completion--twq-all): Use the original completion faces where possible. (completion-styles-alist, completion-ignore-after-point--force-nil) (completions-ignored, completion-ignore-after-point-try-completion) (completion-ignore-after-point-all-completions): Add ignore-after-point completion style. (bug#70968) * lisp/simple.el (choose-completion-string--should-exit): Add. (choose-completion-string): Call choose-completion-string--should-exit. --- lisp/minibuffer.el | 142 ++++++++++++++++++++++++++++++++++++--------- lisp/simple.el | 47 +++++++++------ 2 files changed, 142 insertions(+), 47 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 72ee5d02002..e5d85ed6fc8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -674,34 +674,42 @@ completion--twq-all ;; requote them, so that *Completions* can show nicer unquoted values ;; which only get quoted when needed by choose-completion. (nconc - (mapcar (lambda (completion) - (cl-assert (string-prefix-p prefix completion 'ignore-case) t) - (let* ((new (substring completion (length prefix))) - (qnew (funcall qfun new)) - (qprefix - (if (not completion-ignore-case) - qprefix - ;; Make qprefix inherit the case from `completion'. - (let* ((rest (substring completion - 0 (length prefix))) - (qrest (funcall qfun rest))) - (if (string-equal-ignore-case qprefix qrest) - (propertize qrest 'face - 'completions-common-part) - qprefix)))) - (qcompletion (concat qprefix qnew))) - ;; FIXME: Similarly here, Cygwin's mapping trips this - ;; assertion. - ;;(cl-assert - ;; (string-equal-ignore-case - ;; (funcall unquote - ;; (concat (substring string 0 qboundary) - ;; qcompletion)) - ;; (concat (substring ustring 0 boundary) - ;; completion)) - ;; t) - qcompletion)) - completions) + (mapcar + (if (string-equal qprefix prefix) + ;; There's no quoting in the prefix; quoting in the completions + ;; can be simpler and preserve the existing faces. + (lambda (completion) + (concat + (substring completion 0 (length prefix)) + (funcall qfun (substring completion (length prefix))))) + (lambda (completion) + (cl-assert (string-prefix-p prefix completion 'ignore-case) t) + (let* ((new (substring completion (length prefix))) + (qnew (funcall qfun new)) + (qprefix + (if (not completion-ignore-case) + qprefix + ;; Make qprefix inherit the case from `completion'. + (let* ((rest (substring completion + 0 (length prefix))) + (qrest (funcall qfun rest))) + (if (string-equal-ignore-case qprefix qrest) + (propertize qrest 'face + 'completions-common-part) + qprefix)))) + (qcompletion (concat qprefix qnew))) + ;; FIXME: Similarly here, Cygwin's mapping trips this + ;; assertion. + ;;(cl-assert + ;; (string-equal-ignore-case + ;; (funcall unquote + ;; (concat (substring string 0 qboundary) + ;; qcompletion)) + ;; (concat (substring ustring 0 boundary) + ;; completion)) + ;; t) + qcompletion))) + completions) qboundary)))) ;;; Minibuffer completion @@ -1038,6 +1046,12 @@ completion-styles-alist "Prefix completion that only operates on the text before point. I.e. when completing \"foo_bar\" (where _ is the position of point), it will consider all completions candidates matching the glob +pattern \"foo*\" and will add back \"bar\" to the end of it.") + (ignore-after-point + completion-ignore-after-point-try-completion completion-ignore-after-point-all-completions + "Prefix completion that only operates on the text before point. +I.e. when completing \"foo_bar\" (where _ is the position of point), +it will consider all completions candidates matching the glob pattern \"foo*\" and will add back \"bar\" to the end of it.") (basic completion-basic-try-completion completion-basic-all-completions @@ -3692,6 +3706,78 @@ completion-emacs22-all-completions point (car (completion-boundaries beforepoint table pred ""))))) +;;; ignore-after-point completion style. + +(defvar completion-ignore-after-point--force-nil nil + "When non-nil, the ignore-after-point style always returns nil.") + +(defface completions-ignored + '((t (:inherit shadow))) + "Face for text which was ignored by the completion style.") + +(defun completion-ignore-after-point-try-completion (string table pred point) + "Run `completion-try-completion' ignoring the part of STRING after POINT. + +We add the part of STRING after POINT back to the result." + (let ((prefix (substring string 0 point)) + (suffix (substring string point))) + (when-let ((completion + (unless completion-ignore-after-point--force-nil + (let ((completion-ignore-after-point--force-nil t)) + (completion-try-completion prefix table pred point))))) + ;; Add SUFFIX back to COMPLETION. However, previous completion styles failed and + ;; this one succeeded by ignoring SUFFIX. The success of future completion depends + ;; on ignoring SUFFIX. We mostly do that by keeping point right before SUFFIX. + (if (eq completion t) + ;; Keep point in the same place, right before SUFFIX. + (cons string point) + (let ((newstring (car completion)) + (newpoint (cdr completion))) + (cond + ((= (length newstring) newpoint) + ;; NEWPOINT is already right before SUFFIX. + (cons (concat newstring suffix) newpoint)) + ((minibufferp completion-reference-buffer) + ;; Don't allow moving point, keep it right before SUFFIX. + (cons (concat newstring suffix) (length newstring))) + (t + ;; If we're not in a minibuffer, then we're using `completion-at-point', which + ;; calculates a completion region to complete over. We can allow point to + ;; move and still cause SUFFIX to be omitted from the completion region, by + ;; including a space right before SUFFIX. + (cons (concat newstring + ;; Don't add another space if SUFFIX already starts with one. + (when (/= (aref suffix 0) ? ) " ") suffix) + newpoint)))))))) + +(defun completion-ignore-after-point-all-completions (string table pred point) + "Run `completion-all-completions' ignoring the part of STRING after POINT." + (let ((prefix (substring string 0 point)) + (suffix (propertize (substring string point) 'face 'completions-ignored))) + (when-let ((completions + (unless completion-ignore-after-point--force-nil + (let ((completion-ignore-after-point--force-nil t)) + (completion-all-completions prefix table pred point))))) + ;; Add SUFFIX back to each completion. COMPLETIONS may be an improper list (with + ;; the base position in its last cdr) so we can't use `mapcar'. + (let ((tail completions)) + (while (consp tail) + (let* ((completion (car tail)) + (choose-completion-will-exit + (and (minibufferp completion-reference-buffer) + (choose-completion-string--should-exit completion)))) + ;; Include the suffix if, after `choose-completion' runs on COMPLETION, the + ;; user is still able to use and edit the suffix. + (unless choose-completion-will-exit + (let ((end-of-real-completion (length completion))) + (setcar tail (concat completion suffix)) + ;; When chosen, point should go before SUFFIX. + (put-text-property + 0 1 'completion-position-after-insert end-of-real-completion + (car tail))))) + (setq tail (cdr tail)))) + completions))) + ;;; Basic completion. (defun completion--merge-suffix (completion point suffix) diff --git a/lisp/simple.el b/lisp/simple.el index 1dd6bfe5b22..fe68f23c4da 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10083,6 +10083,20 @@ choose-completion-string-functions If all functions in the list return nil, that means to use the default method of inserting the completion in BUFFER.") +(defun choose-completion-string--should-exit (result) + "Should `choose-completion-string' exit the minibuffer if RESULT is chosen?" + (and + (not completion-no-auto-exit) + minibuffer-completion-table + ;; If this is reading a file name, and the file name chosen + ;; is a directory, don't exit the minibuffer. + (let ((bounds (completion-boundaries + result minibuffer-completion-table + minibuffer-completion-predicate ""))) + ;; The completion chosen leads to a new set of completions + ;; (e.g. it's a directory): don't exit the minibuffer yet. + (not (eq (car bounds) (length result)))))) + (defun choose-completion-string (choice &optional buffer base-position insert-function) "Switch to BUFFER and insert the completion choice CHOICE. @@ -10116,10 +10130,13 @@ choose-completion-string ;; comes from buffer-substring-no-properties. ;;(remove-text-properties 0 (length choice) '(mouse-face nil) choice) ;; Insert the completion into the buffer where it was requested. - (funcall (or insert-function completion-list-insert-choice-function) - (or (car base-position) (point)) - (or (cadr base-position) (point)) - choice) + (let ((beg (or (car base-position) (point))) + (end (or (cadr base-position) (point)))) + (funcall (or insert-function completion-list-insert-choice-function) + beg end choice) + (unless (string-empty-p choice) + (when-let ((pos (get-text-property 0 'completion-position-after-insert choice))) + (goto-char (+ pos beg))))) ;; Update point in the window that BUFFER is showing in. (let ((window (get-buffer-window buffer t))) (set-window-point window (point))) @@ -10127,21 +10144,13 @@ choose-completion-string (and (not completion-no-auto-exit) (minibufferp buffer) minibuffer-completion-table - ;; If this is reading a file name, and the file name chosen - ;; is a directory, don't exit the minibuffer. - (let* ((result (buffer-substring (field-beginning) (point))) - (bounds - (completion-boundaries result minibuffer-completion-table - minibuffer-completion-predicate - ""))) - (if (eq (car bounds) (length result)) - ;; The completion chosen leads to a new set of completions - ;; (e.g. it's a directory): don't exit the minibuffer yet. - (let ((mini (active-minibuffer-window))) - (select-window mini) - (when minibuffer-auto-raise - (raise-frame (window-frame mini)))) - (exit-minibuffer)))))))) + (if (choose-completion-string--should-exit + (buffer-substring (field-beginning) (point))) + (exit-minibuffer) + (let ((mini (active-minibuffer-window))) + (select-window mini) + (when minibuffer-auto-raise + (raise-frame (window-frame mini)))))))))) (define-derived-mode completion-list-mode nil "Completion List" "Major mode for buffers showing lists of possible completions. -- 2.39.3