summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoão Távora <joaotavora@gmail.com>2021-10-06 11:30:29 +0100
committerJoão Távora <joaotavora@gmail.com>2021-10-06 11:42:48 +0100
commitf9f64c4b3287d7276c8edeacdecfa9c78194447b (patch)
tree1f4a4e75012288e48f2bb54fb274d3faff99c838
parentd3a832a61ab5766b6ec879cee9ab75bbbc62034a (diff)
downloademacs-scratch/bug-50959-fix.tar.gz
Complete shorthands to longhands for symbol-completing tablesscratch/bug-50959-fix
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.
-rw-r--r--lisp/help-fns.el7
-rw-r--r--lisp/minibuffer.el51
2 files changed, 53 insertions, 5 deletions
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6be5cd4a501..03bbc979a9c 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -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)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1e1a6f852e8..48859585bc2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -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)