Complete shorthands to longhands for symbol-completing tables

Shorthands aren't symbols, they're text forms that 'read' into
symbols.  As such, shorthands aren't candidates in these tables of
symbols.  But in some situations, if no other candidates match the
pattern, we can e.g. complete "x-foo" to "xavier-foo" if the shorthand

  (("x-" . "xavier-"))

is set up in the buffer of origin.

bug#50959

* lisp/help-fns.el (help--symbol-completion-table): Report
`symbol-help' category.

* lisp/minibuffer.el (completion-styles-alist): New 'shorthand'
style.
(completion-category-defaults): Link 'symbol-help' category with
'shorthand' style.
(minibuffer--original-buffer): New variable.
(completing-read-default): Setup minibuffer--original-buffer.
(completion-shorthand-try-completion)
(completion-shorthand-all-completions): New helpers.
This commit is contained in:
João Távora 2021-10-06 11:30:29 +01:00
parent c2513c5d0d
commit 4c7e74c386
2 changed files with 53 additions and 5 deletions

View file

@ -176,8 +176,11 @@ with the current prefix. The files are chosen according to
completions))
(defun help--symbol-completion-table (string pred action)
(if (and completions-detailed (eq action 'metadata))
'(metadata (affixation-function . help--symbol-completion-table-affixation))
(if (eq action 'metadata)
`(metadata
,@(when completions-detailed
'((affixation-function . help--symbol-completion-table-affixation)))
(category . symbol-help))
(when help-enable-completion-autoload
(let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
(help--load-prefixes prefixes)))

View file

@ -943,7 +943,12 @@ When completing \"foo\" the glob \"*f*o*o*\" is used, so that
completion-initials-try-completion completion-initials-all-completions
"Completion of acronyms and initialisms.
E.g. can complete M-x lch to list-command-history
and C-x C-f ~/sew to ~/src/emacs/work."))
and C-x C-f ~/sew to ~/src/emacs/work.")
(shorthand
completion-shorthand-try-completion completion-shorthand-all-completions
"Completion of symbol shorthands setup in `read-symbol-shorthands'.
E.g. can complete \"x-foo\" to \"xavier-foo\" if the shorthand
((\"x-\" . \"xavier-\")) is set up in the buffer of origin."))
"List of available completion styles.
Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC):
where NAME is the name that should be used in `completion-styles',
@ -990,7 +995,8 @@ styles for specific categories, such as files, buffers, etc."
;; e.g. one that does not anchor to bos.
(project-file (styles . (substring)))
(xref-location (styles . (substring)))
(info-menu (styles . (basic substring))))
(info-menu (styles . (basic substring)))
(symbol-help (styles . (basic shorthand substring))))
"Default settings for specific completion categories.
Each entry has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
@ -1618,6 +1624,9 @@ DONT-CYCLE tells the function not to setup cycling."
(defvar minibuffer--require-match nil
"Value of REQUIRE-MATCH passed to `completing-read'.")
(defvar minibuffer--original-buffer nil
"Buffer that was current when `completing-read' was called.")
(defun minibuffer-complete-and-exit ()
"Exit if the minibuffer contains a valid completion.
Otherwise, try to complete the minibuffer contents. If
@ -4080,6 +4089,40 @@ which is at the core of flex logic. The extra
(let ((newstr (completion-initials-expand string table pred)))
(when newstr
(completion-pcm-try-completion newstr table pred (length newstr)))))
;; Shorthand completion
;;
;; Iff there is a (("x-" . "string-library-")) shorthand setup and
;; string-library-foo is in candidates, complete x-foo to it.
(defun completion-shorthand-try-completion (string table pred point)
"Try completion with `read-symbol-shorthands' of original buffer."
(cl-loop with expanded
for (short . long) in
(with-current-buffer minibuffer--original-buffer
read-symbol-shorthands)
for probe =
(and (> point (length short))
(string-prefix-p short string)
(try-completion (setq expanded
(concat long
(substring
string
(length short))))
table pred))
when probe
do (message "Shorthand expansion")
and return (cons expanded (max (length long)
(+ (- point (length short))
(length long))))))
(defun completion-shorthand-all-completions (string table pred _point)
;; no-op: For now, we don't want shorthands to list all the possible
;; locally active longhands. For the completion categories where
;; this style is active, it could hide other more interesting
;; matches from subsequent styles.
nil)
(defvar completing-read-function #'completing-read-default
"The function called by `completing-read' to do its work.
@ -4111,6 +4154,7 @@ See `completing-read' for the meaning of the arguments."
;; in minibuffer-local-filename-completion-map can
;; override bindings in base-keymap.
base-keymap)))
(buffer (current-buffer))
(result
(minibuffer-with-setup-hook
(lambda ()
@ -4119,7 +4163,8 @@ See `completing-read' for the meaning of the arguments."
;; FIXME: Remove/rename this var, see the next one.
(setq-local minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(setq-local minibuffer--require-match require-match))
(setq-local minibuffer--require-match require-match)
(setq-local minibuffer--original-buffer buffer))
(read-from-minibuffer prompt initial-input keymap
nil hist def inherit-input-method))))
(when (and (equal result "") def)