Improve completion for hash-langs; support completion categories

Use value of forward-sexp-function as a signal whether to assume sexps
for completion boundaries and whether to check for being inside a
racket-lang require form.

Have our completion tables supply "category" metadata. This allows the
user to configure completion matching styles (e.g. "basic", "flex",
and others) appropriate to the kind of thing being completed.

racket-complete.el

@@ -1,6 +1,6 @@
 ;;; racket-complete.el -*- lexical-binding: t -*-
 
-;; Copyright (c) 2013-2020 by Greg Hendershott.
+;; Copyright (c) 2013-2023 by Greg Hendershott.
 ;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
 
 ;; Author: Greg Hendershott
@@ -11,6 +11,14 @@
 (require 'racket-common)
 
 (defun racket--call-with-completion-prefix-positions (proc)
+  (if forward-sexp-function ;not necessarily sexp lang
+      (condition-case nil
+          (save-excursion
+            (let ((beg (progn (forward-sexp -1) (point)))
+                  (end (progn (forward-sexp  1) (point))))
+              (when (<= (+ beg 2) end)  ;prefix at least 2 chars
+                (funcall proc beg end))))
+        (error nil)))
   (let ((beg (save-excursion (skip-syntax-backward "^-()>") (point))))
     (unless (or (eq beg (point-max))
                 (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
@@ -19,25 +27,51 @@
             (goto-char beg)
             (forward-sexp 1)
             (let ((end (point)))
-              (and
-               (<= (+ beg 2) end) ;prefix at least 2 chars
+              (when (<= (+ beg 2) end) ;prefix at least 2 chars
                (funcall proc beg end))))
-        (scan-error nil)))))
+        (error nil)))))
 
 (defun racket--in-require-form-p ()
-  (save-excursion
-    (save-match-data
-      (racket--escape-string-or-comment)
-      (let ((done nil)
-            (result nil))
-        (condition-case ()
-            (while (not done)
-              (backward-up-list)
-              (when (looking-at-p (rx ?\( (or "require" "#%require")))
-                (setq done t)
-                (setq result t)))
-          (scan-error nil))
-        result))))
+  (unless forward-sexp-function ;not necessarily sexp lang
+    (save-excursion
+      (save-match-data
+        (racket--escape-string-or-comment)
+        (let ((done nil)
+              (result nil))
+          (condition-case ()
+              (while (not done)
+                (backward-up-list)
+                (when (looking-at-p (rx ?\( (or "require" "#%require")))
+                  (setq done t)
+                  (setq result t)))
+            (scan-error nil))
+          result)))))
+
+;;; Completion tables with "category" metadata
+
+(defconst racket--identifier-category 'racket-identifier
+  "Value for category metadata of identifier completion tables.")
+
+;; Suggest default; can customize via `completion-category-overrides'.
+(add-to-list 'completion-category-defaults
+             `(,racket--identifier-category (styles basic)))
+
+(defun racket--completion-table (completions &optional category)
+  "Like `completion-table-dynamic' but we supply category metadata.
+
+CATEGORY defaults to `racket--identifier-category'.
+
+Category metadata needs to be returned by the completion table
+function itself, unlike metadata supplied as properties in the
+`completion-at-point-functions' list.
+
+Supplying category metadata allows the user to configure a
+completion matching style for that category."
+  (let ((category (or category racket--identifier-category)))
+    (lambda (prefix predicate action)
+      (if (eq action 'metadata)
+          `(metadata (category . ,category))
+        (complete-with-action action completions prefix predicate)))))
 
 (provide 'racket-complete)
 

racket-edit.el

@@ -436,16 +436,15 @@ When LISTP is true, expects couples to be `[id val]`, else `id val`."
 
 ;;; Completion
 
-(defvar racket--completion-candidates (list racket-type-list
-                                            racket-keywords
-                                            racket-builtins-1-of-2
-                                            racket-builtins-2-of-2))
-
-(defun racket--completion-candidates-for-prefix (prefix)
-  (cl-reduce (lambda (results strs)
-               (append results (all-completions prefix strs)))
-             racket--completion-candidates
-             :initial-value ()))
+(defconst racket--completion-candidates
+  (seq-sort #'string-lessp
+            (seq-reduce (lambda (accum xs)
+                          (append accum xs))
+                        (list racket-type-list
+                              racket-keywords
+                              racket-builtins-1-of-2
+                              racket-builtins-2-of-2)
+                        nil)))
 
 (defun racket-complete-at-point ()
   "A value for the variable `completion-at-point-functions'.
@@ -457,8 +456,7 @@ completion candidates, enable the minor mode `racket-xp-mode'."
    (lambda (beg end)
      (list beg
            end
-           (completion-table-dynamic
-            #'racket--completion-candidates-for-prefix)
+           (racket--completion-table racket--completion-candidates)
            :predicate #'identity
            :exclusive 'no))))
 

racket-repl.el

@@ -1108,9 +1108,6 @@ image."
 
 (add-hook 'racket--repl-after-run-hook   #'racket--repl-refresh-namespace-symbols)
 
-(defun racket--repl-completion-candidates-for-prefix (prefix)
-  (all-completions prefix racket--repl-namespace-symbols))
-
 (defun racket-repl-complete-at-point ()
   "A value for the variable `completion-at-point-functions'.
 
@@ -1124,8 +1121,7 @@ to supply this quickly enough or at all."
    (lambda (beg end)
      (list beg
            end
-           (completion-table-dynamic
-            #'racket--repl-completion-candidates-for-prefix)
+           (racket--completion-table racket--repl-namespace-symbols)
            :predicate #'identity
            :exclusive 'no
            :company-doc-buffer #'racket--repl-company-doc-buffer

racket-xp-complete.el

@@ -51,10 +51,7 @@ Set by `racket-xp-mode'. Used by `racket-xp-complete-at-point'.")
 (defun racket--xp-capf-bindings (beg end)
   (list beg
         end
-        (completion-table-dynamic
-         (lambda (prefix)
-           (all-completions prefix racket--xp-binding-completions)))
-        :predicate          #'identity
+        (racket--completion-table racket--xp-binding-completions)
         :exclusive          'no
         :company-location   (racket--xp-make-company-location-proc)
         :company-doc-buffer (racket--xp-make-company-doc-buffer-proc)))
@@ -73,9 +70,7 @@ that are require transformers."
 (defun racket--xp-capf-absolute-module-paths (beg end)
   (list beg
         end
-        (completion-table-dynamic
-         (lambda (prefix)
-           (all-completions prefix racket--xp-module-completions)))
+        (racket--completion-table racket--xp-module-completions)
         :exclusive 'no))
 
 (defun racket--xp-capf-relative-module-paths ()
@@ -89,7 +84,7 @@ that are require transformers."
                                 table)))
             (list beg
                   end
-                  table
+                  (racket--completion-table table 'file)
                   :exclusive 'no))))))))
 
 (defun racket--xp-make-company-location-proc ()