bug#50959: [PATCH] Re: bug#50959: 28.0.50; Shorthand symbols are unknown to Emacs

[João Távora]

João Távora <joaotavora@gmail.com> writes:

> On Sat, Oct 2, 2021 at 1:30 PM Eli Zaretskii <eliz@gnu.org> wrote:

>> > 0. no integration
>> >
>> > 1. This is the current integration.  I.e. when C-h o is pressed on the
>> >    symbol the global name is discovered and used as the default.  This
>> >    is how SLIME work with CL's namespacing system.  SLIME is a very well
>> >    tested and widely appreciated Common Lisp IDE for Emcas.
>> >
>> > 2. The shorthands from the buffer where the minibuffer was entered are
>> >    _not_ in the completions list, but typing one of them interns the
>> >    symbol with those shorthands present, so you get the desired result.
>> >    This would fix Phil's visually-copy-and-type scenario.
>> >
>> > 3. The completion list would be augmented with the shorthands from
>> >    the buffer where the minibuffer was entered from.

Hello Eli,

I've implemented a variation on 2 based on the later suggestion you
gave in emacs-devel:

> That is, the user types "C-h o s-foo <SOME KEY SEQUENCE>" and that
> replaces s-foo with the expansion, the "real" symbol.  Is that
> feasible?

Yes, it is.  <SOME KEY SEQUENCE> is, of course, TAB.  Here is a patch
for people to try out which I will push in a few days time if there are
no objections.  Cc-ing completion-style specialist Stefan.

Patch just below,
João

commit f9f64c4b3287d7276c8edeacdecfa9c78194447b
Author: João Távora <joaotavora@gmail.com>
Date:   Wed Oct 6 11:30:29 2021 +0100

    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.

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6be5cd4a50..03bbc979a9 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -176,8 +176,11 @@ help--symbol-completion-table-affixation
           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 1e1a6f852e..48859585bc 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -943,7 +943,12 @@ completion-styles-alist
      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 @@ completion-category-defaults
     ;; 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 @@ minibuffer-confirm-exit-commands
 (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 @@ completion-initials-try-completion
   (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 @@ completing-read-default
                     ;; 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 @@ completing-read-default
                 ;; 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)