Re: Thoughts on Refactoring In-Buffer Completion In message.el

[Alexander Adolf <alexander.adolf@condition-alpha.com>]

[-- Attachment #1: Type: text/plain, Size: 2092 bytes --]

Hello Stefan, Emacs developers,

below is an initial sketch of the first refactoring step I had outlined
in my previous message. Hope this helps make things more tangible.

All comments invited & welcome!

What it does:

- it updates the variable message-completion-alist instead of just a
  function, to use a plist as its cdr type;

- the plist contains the completion category to use, the completion
  styles associated with that category, and the completion function to
  use to generate candidates.


How it improves over the previous version:

- makes the completion category visible in a defcustom, so users know
  which category applies, without diving into the code of message.el;

- for the first time defines a completion category for newsgroup names,
  and adds that category to the newsgroups completion table, and
  consequently resolves a FIXME;

- all completion-category-defaults changes instead of hard-coded values
  now use values configured in message-completion-alist.


Where it still needs improvement:

- message-completion-alist should probably have a setter function, since
  changes to the completion styles will only take effect after Emacs
  restart;

- there should probably be convenience functions for users to change the
  settings in the plist in message-completion-alist from their init
  files (too easy to get wrong).


What do I have in mind beyond this first step?

- Could message-complete-name be replaced by
  eudc-capf-message-expand-name as the default function in
  message-completion-alist?

- Could, or should the field separator for scanning backwards on the
  message header line be specified in message-completion-alist?

- In principle, all code dealing with bbdb, ecomplete, and mailabbrev
  could be removed from message.el, and these packages could deliver
  their completion candidates to EUDC. EUDC would do the search results
  merging, and it has a back-end for bbdb already. Thus, new EUDC
  back-ends would need to be written for ecomplete, and mailabbrev only.



Many thanks and looking forward to your thoughts,

  --alexander


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Refactoring-Message-Completion-Alist.patch --]
[-- Type: text/x-patch, Size: 9034 bytes --]

From d7b4fbed9c34b7c73d59d8f709934a548c109149 Mon Sep 17 00:00:00 2001
From: Alexander Adolf <alexander.adolf@condition-alpha.com>
Date: Tue, 19 Jul 2022 22:31:58 +0200
Subject: [PATCH] Refactoring Message-Completion-Alist

* lisp/gnus/message.el (message-completion-alist): alist cdr replaced
by plist
(message-completion-function): handle new plist cdr type in
message-completion-alist
(message-expand-group): add completion category metadata (FIXME)
(completion-category-defaults): set group category and its defaults
from message-completion-alist
(completion-category-defaults): set email category and its defaults
from message-completion-alist instead of hard coded values
(message--name-table): set category metadata from
message-completion-alist instead of hard coded values
---
 lisp/gnus/message.el | 137 +++++++++++++++++++++++++++++++++----------
 1 file changed, 107 insertions(+), 30 deletions(-)

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 7c2b24c6ee..3dafc89970 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3180,7 +3180,6 @@ message-mode
     (mail-abbrevs-setup))
    ((message-mail-alias-type-p 'ecomplete)
     (ecomplete-setup)))
-  (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t)
   (add-hook 'completion-at-point-functions #'message-completion-function nil t)
   (unless buffer-file-name
     (message-set-auto-save-file-name))
@@ -8244,14 +8243,51 @@ message-email-recipient-header-regexp
   :type 'regexp)
 
 (defcustom message-completion-alist
-  `((,message-newgroups-header-regexp . ,#'message-expand-group)
-    (,message-email-recipient-header-regexp . ,#'message-expand-name))
-  "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE.
-FUN should be a function that obeys the same rules as those
-of `completion-at-point-functions'."
-  :version "27.1"
+  `((,message-newgroups-header-regexp . (:category group
+                                         :styles (substring partial-completion)
+                                         :completions ,#'message-expand-group))
+    (,message-email-recipient-header-regexp . (:category email
+                                               :styles (substring partial-completion)
+                                               :completions ,#'message-expand-name)))
+  "Alist of (RE . RECIPE), defining completion contexts.
+This variable controls how `message-completion-function' performs
+in-buffer completion.  RECIPE is either a function (deprecated),
+or a plist.
+
+When `message-completion-function' is invoked, and point is on a
+line matching one of the REs in the alist, the settings in the
+corresponding RECIPE are applied.
+
+When RECIPE is a function, it is called for completion.  RECIPE
+should be a function that obeys the same rules as those of
+`completion-at-point-functions'.
+
+When RECIPE is a plist, the stored properties are used to control
+how in-buffer completion is performed.  The following properties
+are currently defined:
+
+:category
+
+    The symbol defining the category in
+    `completion-category-defaults' to use for completion.  Also
+    see `completion-category-overrides'.
+
+:styles
+
+    The list of `completion-styles' to use for that category.
+
+:completions
+
+    The function that provides completions, and that obeys the
+    same rules as those of `completion-at-point-functions'.
+    In-buffer completion will be performed as if
+    `completion-at-point-functions' had been set to this value."
+  :version "29.1"
   :group 'message
-  :type '(alist :key-type regexp :value-type function))
+  :type '(alist :key-type regexp
+                :value-type (choice (plist)
+                                    (function
+                                     :tag "Completion function (deprecated)"))))
 
 (defcustom message-expand-name-databases
   '(bbdb eudc)
@@ -8299,22 +8335,29 @@ message-completion-function
       (setq alist (cdr alist)))
     (when (cdar alist)
       (let ((fun (cdar alist)))
-        (if (member fun message--old-style-completion-functions)
-            (lambda ()
-              (funcall fun)
-              ;; Even if completion fails, return a non-nil value, so as to
-              ;; avoid falling back to message-tab-body-function.
-              'completion-attempted)
-          (let ((ticks-before (buffer-chars-modified-tick))
-                (data (funcall fun)))
-            (if (and (eq ticks-before (buffer-chars-modified-tick))
-                     (or (null data)
-                         (integerp (car-safe data))))
-                data
-              (push fun message--old-style-completion-functions)
-              ;; Completion was already performed, so just return a dummy
-              ;; function that prevents trying any further.
-              (lambda () 'completion-attempted))))))))
+        (pcase fun
+          ((pred functionp)
+           (if (member fun message--old-style-completion-functions)
+               (lambda ()
+                 (funcall fun)
+                 ;; Even if completion fails, return a non-nil value, so as to
+                 ;; avoid falling back to message-tab-body-function.
+                 'completion-attempted)
+             (let ((ticks-before (buffer-chars-modified-tick))
+                   (data (funcall fun)))
+               (if (and (eq ticks-before (buffer-chars-modified-tick))
+                        (or (null data)
+                            (integerp (car-safe data))))
+                   data
+                 (push fun message--old-style-completion-functions)
+                 ;; Completion was already performed, so just return a dummy
+                 ;; function that prevents trying any further.
+                 (lambda () 'completion-attempted)))))
+          (_
+           (let* ((recipe (alist-get message-email-recipient-header-regexp
+                                     message-completion-alist))
+                  (completions-function (plist-get recipe :completions)))
+             (funcall completions-function))))))))
 
 (defun message-expand-group ()
   "Expand the group name under point."
@@ -8333,9 +8376,28 @@ message-expand-group
 			       gnus-active-hashtb)
 		      (hash-table-keys gnus-active-hashtb))))
     (when collection
-      ;; FIXME: Add `category' metadata to the collection, so we can use
-      ;; substring matching on it.
-      (list b e collection))))
+      (let ((res (list b e collection))
+            (cat (plist-get (alist-get
+                             message-newgroups-header-regexp
+                             message-completion-alist)
+                            :category)))
+        (when cat
+          (setq res (cons res `(metadata ((category . ,cat))))))
+        res)
+      )))
+
+;; set completion category defaults for newsgroup names based the on
+;; settings in `message-completion-alist'
+(let ((recipe (alist-get message-newgroups-header-regexp
+                         message-completion-alist)))
+  (pcase recipe
+    ((pred functionp)
+     (add-to-list 'completion-category-defaults
+                  '(group (styles substring partial-completion))))
+    (_
+     (add-to-list 'completion-category-defaults
+                  `(,(plist-get recipe :category)
+                    (styles ,@(plist-get recipe :styles)))))))
 
 (defcustom message-expand-name-standard-ui nil
   "If non-nil, use the standard completion UI in `message-expand-name'.
@@ -8372,8 +8434,18 @@ message-expand-name
 	(t
 	 (expand-abbrev))))
 
-(add-to-list 'completion-category-defaults '(email (styles substring
-                                                           partial-completion)))
+;; set completion category defaults for email addresses based the on
+;; settings in `message-completion-alist'
+(let ((recipe (alist-get message-email-recipient-header-regexp
+                         message-completion-alist)))
+  (pcase recipe
+    ((pred functionp)
+     (add-to-list 'completion-category-defaults
+                  '(email (styles substring partial-completion))))
+    (_
+     (add-to-list 'completion-category-defaults
+                  `(,(plist-get recipe :category)
+                    (styles ,@(plist-get recipe :styles)))))))
 
 (defun message--bbdb-query-with-words (words)
   ;; FIXME: This (or something like this) should live on the BBDB side.
@@ -8402,7 +8474,12 @@ message--name-table
         bbdb-responses)
     (lambda (string pred action)
       (pcase action
-        ('metadata '(metadata (category . email)))
+        ('metadata (let* ((recipe (alist-get message-email-recipient-header-regexp
+                                             message-completion-alist))
+                          (cat (plist-get recipe :category)))
+                     (pcase recipe
+                       ((pred functionp) '(metadata (category . email)))
+                       (_ (when cat `(metadata (category . ,cat)))))))
         ('lambda t)
         ((or 'nil 't)
          (when orig-words
-- 
2.37.0