* Thoughts on Refactoring In-Buffer Completion In message.el
@ 2022-06-23 15:26 Alexander Adolf
2022-06-25 4:35 ` Thomas Fitzsimmons
2022-06-25 8:22 ` Stefan Monnier
0 siblings, 2 replies; 16+ messages in thread
From: Alexander Adolf @ 2022-06-23 15:26 UTC (permalink / raw)
To: emacs-devel
Hello,
<disclaimer>
message.el is a massive file (some 8600 lines), and I can't claim
having read or understood any substantial portion of it. All
statements solely rely on the (small) portions of the code around
completion in message.el, which I have looked at. Thus, as always in
life, I shall be looking froward to standing corrected and
enlightened wherever I deserve it. ;-)
</disclaimer>
Regarding in-buffer completion, message-mode is probably a rather
specific case as it has succinctly distinct in-buffer completion
contexts. Think for instance of a body or subject line, vs. a To header
line, vs. a References header line, vs. a Newsgroups header line.
Currently, message-mode employs two mechanisms for handling these
contextss:
• Its completion function message-completion-function is registered in
completion-at-point-functions, and marshals the in-buffer completion
contexts via the variable message-completion-alist.
message-completion-alist in turn configures the (one and only)
function to be called for completion candidates in a given context.
• The completion style to use for email addresses is added to the
variable completion-category-defaults.
What made me start scratching my head about this, was the wish to
combine email address candidates from more than one source, and have
them be presented in a single list by completion-at-point. Since EUDC
had recently gained the ability to return combined search results from
several of its back-ends [1], I put together a new EUDC function that
can be added to completion-at-point-functions. My new function gets
added to the front of completion-at-point-functions in message-mode, and
email address completion candidates from the EUDC back-ends I have
configured show up when completion-at-point is triggered [2].
[1] commit 0470a4a939772c4bd25123b15f5eadab41f8bee5
[2] commit 620ac6735520aea97ce49059b0df38ed41930b6b
So far so good; this satisfies my immediate use-case.
Job done? Looking at [2], you'll notice that I need to check in my new
EUDC completion function whether point is actually on a To, Cc, etc.
line. Otherwise email addresses would happily be offered as completion
candidates in the middle of the subject, or in the body. Having this
extra check for an email message header line in EUDC code didn't feel
quite right, however. Think "separation of concerns".
Further looking at message.el, and how in-buffer completion is handled
there, you'll find that there is (more or less) close integration with
ecomplete, mailabbrev, EUDC, and bbdb in message.el. Consider, for
instance the defun starting at line 8378 of message.el:
┌────
│ 8377 (defun message--bbdb-query-with-words (words)
│ 8378 ;; FIXME: This (or something like this) should live on the BBDB side.
│ 8379 (when (fboundp 'bbdb-records)
└────
Listing 1: lisp/gnus/message.el "separation of concerns" example
What more should I add? I fully agree with the comment in line 8378.
Again, think "separation of concerns".
On this backdrop, where would I see room for improvement?
Overall, there are a couple of bits an pieces for in-buffer completion
in place in message.el already. But it seems they were developed/added
independently of each other, and a little more orchestration could
perhaps help to make things more flexible, but without reinventing the
wheel.
1) In message.el, combine both completion control mechanisms into a
single one.
At first glance from the end user's point of view,
message-completion-alist and completion-category-defaults can be
perceived as two distinct mechanisms, and it is not immediately
obvious which completion style category applies for which regex in
message-completion-alist. Only by inspecting line 8404 in message.el,
one can discover which category is used:
┌────
│ 8398 (defun message--name-table (orig-string)
│ 8399 (let ((orig-words (split-string orig-string "[ \t]+"))
│ 8400 eudc-responses
│ 8401 bbdb-responses)
│ 8402 (lambda (string pred action)
│ 8403 (pcase action
│ 8404 ('metadata '(metadata (category . email)))
└────
Listing 2: lisp/gnus/message.el completion styles handling
Thus, I would propose to change message-completion-alist from being
alist of (RE . FUN), to become an alist of (RE . PLIST). Two
properties for the inner plist would initially defined; one for
specifying the completion style, and another one for specifying the
completion-at-point-functions. With this, the new default value of
message-completion-alist could for example be along the lines of:
┌────
│ (defcustom message-completion-alist
│ `((,message-newgroups-header-regexp
│ . '(:capf-style 'newsgroup
│ :capf-funs '(gnus-capf-complete))) ;; hypothetical
│ (,message-email-recipient-header-regexp
│ . '(:capf-style 'email
│ :capf-funs '(eudc-capf-complete)))) ;; exists
│ "docstring"
│ )
└────
As an aside: considering the FIXME comment in the function
message-expand-group, newsgroup completion would seem to be able to
benefit from this change, too.
If none of the regular expressions matches, the settings in
completion-at-point-functions, and
completion-category-defaults/overrides will apply as before, or in
other modes.
With such an approach, the end user would get a positive assertion as
to which completion style is used in each part of a message buffer.
2) Refactor ecomplete, mailabbrev, and bbdb stuff out of message.el as
much as possible.
As the FIXME comment in listing 1 above suggests, any "query with
words" functions, or other ecomplete, mailabbrev, or bbdb specific
functions should be in the respective packages themselves
("separation of concerns"). Also, as EUDC performs search result
aggregation across sources, these packages should implement EUDC
back-ends to provide their results via EUDC. Message.el should thus
not interact with any email address database directly, but instead
provide a default configuration where completion-at-point queries
EUDC for email addresses.
In all cases, current default behaviour should be retained as much as
reasonably possible, of course.
Many thanks and looking forward to your thoughts,
-–alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-23 15:26 Thoughts on Refactoring In-Buffer Completion In message.el Alexander Adolf
@ 2022-06-25 4:35 ` Thomas Fitzsimmons
2022-06-27 15:48 ` Alexander Adolf
2022-06-25 8:22 ` Stefan Monnier
1 sibling, 1 reply; 16+ messages in thread
From: Thomas Fitzsimmons @ 2022-06-25 4:35 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
Hi Alexander,
Nice overview, thanks. Do you think it will be possible to do this
refactoring as a series of small individual patches, each of which keeps
things working? I think a series of proposed changes will be easier to
discuss.
Thomas
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-23 15:26 Thoughts on Refactoring In-Buffer Completion In message.el Alexander Adolf
2022-06-25 4:35 ` Thomas Fitzsimmons
@ 2022-06-25 8:22 ` Stefan Monnier
2022-06-27 16:37 ` Alexander Adolf
1 sibling, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2022-06-25 8:22 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
> ┌────
> │ (defcustom message-completion-alist
> │ `((,message-newgroups-header-regexp
> │ . '(:capf-style 'newsgroup
> │ :capf-funs '(gnus-capf-complete))) ;; hypothetical
> │ (,message-email-recipient-header-regexp
> │ . '(:capf-style 'email
> │ :capf-funs '(eudc-capf-complete)))) ;; exists
> │ "docstring"
> │ )
> └────
Sounds fine, tho "capf-style" sounds wrong: these are the names of
categories, not a styles.
Also `capf-funs` sounds wrong: these should be completion tables
not CAPFs. The CAPFs are the functions which decide which completion
table to use and what's the BEG...END that's being completed, and this
should not depend on the backend since they only depend on the format of
messages (and hence belong in `message.el`).
Currently we have `message-completion-alist` which decides on
a line-by-line basis what kind of completion we're doing, and then we
have a specialized function that decides what's the BEG..END to use and
which backend to use.
Maybe `message-completion-alist` should be beefed up so that it cuts
this middle man (specialized function): i.e. provide not just
a line-based regexp to decide which specialized function to use, but
also provide some way to specify the BEG..END and the backend*S*.
Maybe have it be a list of (FUNCTION CATEGORY . BACKENDS) ?
where FUNCTION should return (BEG . END) if this completion applies?
> 2) Refactor ecomplete, mailabbrev, and bbdb stuff out of message.el as
> much as possible.
AFAIK this is already done for `ecomplete`.
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-25 4:35 ` Thomas Fitzsimmons
@ 2022-06-27 15:48 ` Alexander Adolf
0 siblings, 0 replies; 16+ messages in thread
From: Alexander Adolf @ 2022-06-27 15:48 UTC (permalink / raw)
To: Thomas Fitzsimmons; +Cc: emacs-devel
Hello Thomas,
Thomas Fitzsimmons <fitzsim@fitzsim.org> writes:
> [...]
> Nice overview, thanks. Do you think it will be possible to do this
> refactoring as a series of small individual patches, each of which keeps
> things working? I think a series of proposed changes will be easier to
> discuss.
> [...]
You have a good point here. I'll try to structure it that way.
Not sure whether all|some patches will meet everybody's definition of
"small" though... ;-) But I'll try to keep the as small as reasonably
possible.
--alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-25 8:22 ` Stefan Monnier
@ 2022-06-27 16:37 ` Alexander Adolf
2022-06-28 15:49 ` Stefan Monnier
0 siblings, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-06-27 16:37 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Hello Stefan,
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> ┌────
>> │ (defcustom message-completion-alist
>> │ `((,message-newgroups-header-regexp
>> │ . '(:capf-style 'newsgroup
>> │ :capf-funs '(gnus-capf-complete))) ;; hypothetical
>> │ (,message-email-recipient-header-regexp
>> │ . '(:capf-style 'email
>> │ :capf-funs '(eudc-capf-complete)))) ;; exists
>> │ "docstring"
>> │ )
>> └────
>
> Sounds fine, tho "capf-style" sounds wrong: these are the names of
> categories, not a styles.
These names were just for illustration, so happy to use better fitting
names.
Perhaps `completion-style-category`? A shorter version?
> Also `capf-funs` sounds wrong: [...]
They are either tables, or functions that return tables. As of today,
the entries in message-completion-alist are functions.
> Currently we have `message-completion-alist` which decides on
> a line-by-line basis what kind of completion we're doing, and then we
> have a specialized function that decides what's the BEG..END to use and
> which backend to use.
>
> Maybe `message-completion-alist` should be beefed up so that it cuts
> this middle man (specialized function): i.e. provide not just
> a line-based regexp to decide which specialized function to use, but
> also provide some way to specify the BEG..END and the backend*S*.
Good point, and agreed that determining (beg . end) should also be done
in message.Eli.
> Maybe have it be a list of (FUNCTION CATEGORY . BACKENDS) ?
> where FUNCTION should return (BEG . END) if this completion applies?
In some situations this will be called for every keystroke. Would the
extra overhead of a function call seem acceptable for this?
OTOH, the code of each of those functions would probably look extremely
similar. The format of header lines where specific completion is to be
attempted always seems to be:
header-label ':' record | record-list
(I'm thinking of To/Cc/etc. and Newsgroups/Followup-To/etc.)
Thus, the only parameters for such functions would seem to be a regular
expression to match the header-label, and the character (or regex?) that
is used as the record separator. So we might just as well put the
header-label regex, and the record separator char in
`message-completion-alist`?
>> 2) Refactor ecomplete, mailabbrev, and bbdb stuff out of message.el as
>> much as possible.
>
> AFAIK this is already done for `ecomplete`.
> [...]
Searching for `ecomplete` in message.el (tip of master as of this
writing):
message.el
1390:The default is `abbrev', which uses mailabbrev. `ecomplete' uses
1396: (const :tag "Use ecomplete" ecomplete)
1400: "List of `self-insert-command's used to trigger ecomplete.
1402:header, ecomplete will suggest the candidates of recipients (see also
1937:(defvar message-inhibit-ecomplete nil)
3097: (when (and (message-mail-alias-type-p 'ecomplete)
3181: ((message-mail-alias-type-p 'ecomplete)
3182: (ecomplete-setup)))
4445: ;; Do ecomplete address snarfing.
4446: (when (and (message-mail-alias-type-p 'ecomplete)
4447: (not message-inhibit-ecomplete))
4448: (message-put-addresses-in-ecomplete))
8021: (message-inhibit-ecomplete t)
8344:`ecomplete', `message-self-insert-commands' should probably be
8414: (ecomplete-setup)
8420: (when (and (bound-and-true-p ecomplete-database)
8421: (fboundp 'ecomplete-completion-table))
8423: (ecomplete-completion-table 'mail)
8628:(declare-function ecomplete-add-item "ecomplete" (type key text))
8629:(declare-function ecomplete-save "ecomplete" ())
8631:(defun message-put-addresses-in-ecomplete ()
8632: (require 'ecomplete)
8640: (ecomplete-add-item 'mail (car (mail-header-parse-address string))
8642: (ecomplete-save))
8644:(autoload 'ecomplete-display-matches "ecomplete")
8666: (ecomplete-display-matches 'mail word choose))))
8671:(defun message-ecomplete-capf ()
8674: (when (and (bound-and-true-p ecomplete-database)
8675: (fboundp 'ecomplete-completion-table)
8683: `(,start ,end ,(ecomplete-completion-table 'mail)))))
That's 40 hits, and looking at the matching lines, my first impression
would not frankly be that ecomplete integration has been reduced to a
bare minimum.
Looking forward to your thoughts,
--alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-27 16:37 ` Alexander Adolf
@ 2022-06-28 15:49 ` Stefan Monnier
2022-07-19 21:41 ` Alexander Adolf
0 siblings, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2022-06-28 15:49 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
>> Sounds fine, tho "capf-style" sounds wrong: these are the names of
>> categories, not a styles.
> These names were just for illustration, so happy to use better fitting
> names.
> Perhaps `completion-style-category`? A shorter version?
It's not a "style category": it's more a "completion category" (it's not
a classification of styles but a classification of completion candidates).
To any given category the user can then associate some styles (as well
as control the cycling behavior).
>> Also `capf-funs` sounds wrong: [...]
> They are either tables, or functions that return tables.
I think they should be only completion tables (and most/all of those
tables will be functions: completion tables can take the shape of lists
of strings, alists, hash-tables, obarrays, or functions, but the only
think we care about is that they work with the corresponding methods).
That part that's wrong is not "funs" but "capf", because "capf" refers
to `completion-at-point-functions` which are not completion tables but
functions that return (BEG END TABLE). They're related but
they're different.
>> Maybe `message-completion-alist` should be beefed up so that it cuts
>> this middle man (specialized function): i.e. provide not just
>> a line-based regexp to decide which specialized function to use, but
>> also provide some way to specify the BEG..END and the backend*S*.
> Good point, and agreed that determining (beg . end) should also be done
> in message.Eli.
Nice typo, thank you. Indeed, maybe in order to mark the enormous
contribution of Eli to Emacs, maybe ELisp source files should end in
`.Eli` ;-)
>> Maybe have it be a list of (FUNCTION CATEGORY . BACKENDS) ?
>> where FUNCTION should return (BEG . END) if this completion applies?
> In some situations this will be called for every keystroke. Would the
> extra overhead of a function call seem acceptable for this?
An extra function call will be completely lost in the noise, yes.
> OTOH, the code of each of those functions would probably look extremely
> similar. The format of header lines where specific completion is to be
> attempted always seems to be:
>
> header-label ':' record | record-list
>
> (I'm thinking of To/Cc/etc. and Newsgroups/Followup-To/etc.)
>
> Thus, the only parameters for such functions would seem to be a regular
> expression to match the header-label, and the character (or regex?) that
> is used as the record separator. So we might just as well put the
> header-label regex, and the record separator char in
> `message-completion-alist`?
You might be right, maybe we just need to add a record separator.
> 1390:The default is `abbrev', which uses mailabbrev. `ecomplete' uses
> 1396: (const :tag "Use ecomplete" ecomplete)
> 1400: "List of `self-insert-command's used to trigger ecomplete.
> 1402:header, ecomplete will suggest the candidates of recipients (see also
> 1937:(defvar message-inhibit-ecomplete nil)
These non-executable.
> 3097: (when (and (message-mail-alias-type-p 'ecomplete)
> 3181: ((message-mail-alias-type-p 'ecomplete)
> 3182: (ecomplete-setup)))
> 4445: ;; Do ecomplete address snarfing.
> 4446: (when (and (message-mail-alias-type-p 'ecomplete)
> 4447: (not message-inhibit-ecomplete))
> 4448: (message-put-addresses-in-ecomplete))
> 8021: (message-inhibit-ecomplete t)
> 8344:`ecomplete', `message-self-insert-commands' should probably be
> 8414: (ecomplete-setup)
> 8420: (when (and (bound-and-true-p ecomplete-database)
> 8421: (fboundp 'ecomplete-completion-table))
> 8423: (ecomplete-completion-table 'mail)
> 8628:(declare-function ecomplete-add-item "ecomplete" (type key text))
> 8629:(declare-function ecomplete-save "ecomplete" ())
> 8631:(defun message-put-addresses-in-ecomplete ()
> 8632: (require 'ecomplete)
> 8640: (ecomplete-add-item 'mail (car (mail-header-parse-address string))
> 8642: (ecomplete-save))
> 8644:(autoload 'ecomplete-display-matches "ecomplete")
> 8666: (ecomplete-display-matches 'mail word choose))))
> 8671:(defun message-ecomplete-capf ()
> 8674: (when (and (bound-and-true-p ecomplete-database)
> 8675: (fboundp 'ecomplete-completion-table)
> 8683: `(,start ,end ,(ecomplete-completion-table 'mail)))))
>
> That's 40 hits, and looking at the matching lines, my first impression
> would not frankly be that ecomplete integration has been reduced to a
> bare minimum.
Maybe I didn't express myself clearly enough: I meant that the
ecomplete-based *completion* code has been clearly separated.
It basically only uses `ecomplete-completion-table`.
`message-ecomplete-capf` was my first attempt at doing it cleanly: it
was clean alright, but it didn't allow combing this backend with
another one. It's not used any more but is kept in case someone else
still uses it. The place where `ecomplete` completion is used nowadays
is `message--name-table` which is supposed to combine EUDC, BBDB, and
Ecomplete completion tables into a single completion table.
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-06-28 15:49 ` Stefan Monnier
@ 2022-07-19 21:41 ` Alexander Adolf
2022-07-19 22:13 ` Stefan Monnier
0 siblings, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-07-19 21:41 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
[-- 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
^ permalink raw reply related [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-19 21:41 ` Alexander Adolf
@ 2022-07-19 22:13 ` Stefan Monnier
2022-07-20 20:59 ` Alexander Adolf
0 siblings, 1 reply; 16+ messages in thread
From: Stefan Monnier @ 2022-07-19 22:13 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
Hi, thanks,
I think this is looking pretty good.
Here are my comments to your patch.
> @@ -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)))
`group` is too generic a name (remember that those category names are
"global" so they should be meaning in any other context than
message.el).
`newsgroup` maybe?
> +: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."
I think this should be a completion table, not a CAPF function.
> + (_
> + (let* ((recipe (alist-get message-email-recipient-header-regexp
> + message-completion-alist))
> + (completions-function (plist-get recipe :completions)))
> + (funcall completions-function))))))))
Hmm... `recipe` should be (car alist), rather than this
weird (alist-get ...), no?
And then we should do the (skip-chars-forw/backward "^, \t\n") dance
here, as well as the metadata dance to add the `category` if specified
by `recipe`.
> +;; 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)))))))
I'd expect something like a `dolist` loop through
`message-completion-alist` rather than this weird (alist-get ...).
What am I missing?
Also, maybe rather than do this at top level, maybe we could add/set
`completion-category-defaults` directly from
`message-completion-function`, so it's done "more lazily" and so it
dynamically adapts to changes to `message-completion-alist`.
Tho, now that I think about it, having those styles in
`message-completion-alist` is weird: that var is a `defcustom`, hence
a user setting, yet we put it into `completion-category-defaults` which
is not meant to contain user settings (that's what
`completion-category-overrides` is for).
So maybe we should just hardcode
(add-to-list 'completion-category-defaults
'(newsgroup (styles substring partial-completion))))
(add-to-list 'completion-category-defaults
'(email (styles substring partial-completion))))
and remove the `:styles` from `message-completion-alist` since the user
should set `completion-category-overrides` instead.
[ It will also remove the problematic situation where
`message-completion-alist` contains two entries with the same
`:category` but with different `:styles`. ]
> @@ -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)))))))
I think we should do this metadata dance in
`message-completion-function` (where we already have the `recipe` at
hand). Otherwise the `message-completion-alist` would be weird since
the `:category` entry would only be obeyed by those `:completions`
functions which happen to decide to obey it.
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-19 22:13 ` Stefan Monnier
@ 2022-07-20 20:59 ` Alexander Adolf
2022-07-20 23:59 ` Stefan Monnier
0 siblings, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-07-20 20:59 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 3063 bytes --]
Hello Stefan,
Many thanks for your swift response, and helpful comments!
Stefan Monnier <monnier@iro.umontreal.ca> writes:
> [...]
> `group` is too generic a name (remember that those category names are
> "global" so they should be meaning in any other context than
> message.el).
> `newsgroup` maybe?
Good point; 'newsgroup' it is.
>> +: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."
>
> I think this should be a completion table, not a CAPF function.
Why restrict it to a table? Perhaps we should allow both, functions and
tables? Practically, that could mean checking whether the value
satisfies `functionp`, and `funcall` it when that's the case; else use
it as a ready-made table.
It seems I am missing something?
>> + (_
>> + (let* ((recipe (alist-get message-email-recipient-header-regexp
>> + message-completion-alist))
>> + (completions-function (plist-get recipe :completions)))
>> + (funcall completions-function))))))))
>
> Hmm... `recipe` should be (car alist), rather than this
> weird (alist-get ...), no?
I confused myself (and apparently you, too). `recipe` is one and the
same as `fun`; no need for an extra variable.
> And then we should do the (skip-chars-forw/backward "^, \t\n") dance
> here,
Added in the updated patch at the end of this message.
> as well as the metadata dance to add the `category` if specified by
> `recipe`.
Good point. I amended `message-completion-function` to add a metadata
property with category information.
> [...]
> Tho, now that I think about it, having those styles in
> `message-completion-alist` is weird: that var is a `defcustom`, hence
> a user setting, yet we put it into `completion-category-defaults` which
> is not meant to contain user settings (that's what
> `completion-category-overrides` is for).
>
> So maybe we should just hardcode
>
> (add-to-list 'completion-category-defaults
> '(newsgroup (styles substring partial-completion))))
> (add-to-list 'completion-category-defaults
> '(email (styles substring partial-completion))))
>
> and remove the `:styles` from `message-completion-alist` since the user
> should set `completion-category-overrides` instead.
I agree. I hadn't viewed completion-category-defaults as the global
setting it actually is.
Below is the updated patch.
I have made minimally invasive modifications only to
message-expand-name, and message-expand-group. Frankly, my goal is to
not have a message-expand-name at all, but to call some eudc-capf-*
function directly for email addresses.
I also have not added any checking whether individual properties are
present in the plist, or not. What would be the use-case for not
specifying any of the three?
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: 11474 bytes --]
From 87a6778db682395f61b87b629c9553ff90059902 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, add completion category metadata from
message-completion-alist instead of hard coded values (FIXME), use
regex from message-completion-alist to determine prefix
(message-completion-alist-set-completions): new function to help in
writing user init files
(message-expand-group): new optional parameters to receive bounds from
message-completion-function
(message-expand-name): new optional parameters to receive bounds from
message-completion-function
---
lisp/gnus/message.el | 180 +++++++++++++++++++++++++++++++------------
1 file changed, 130 insertions(+), 50 deletions(-)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 7c2b24c6ee..da63e3441d 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,68 @@ 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 newsgroup
+ :fieldsep-re "\\([:,]\\|^\\)[ \t]*"
+ :completions ,#'message-expand-group))
+ (,message-email-recipient-header-regexp . (:category email
+ :fieldsep-re "\\([:,]\\|^\\)[ \t]*"
+ :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', and `completion-styles'.
+
+:fieldsep-re
+
+ The regular expression to use when scanning backwards in the
+ buffer. All text between point, and any preceding text
+ matching this regular expression, will be used as the prefix
+ for finding completion candidates.
+
+: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)"))))
+
+(defun message-completion-alist-set-completions (cat compl)
+ "Set the completion function for category CAT to COMPL.
+Modifies the value of `message-completion-alist'. This is a
+convenience function for use in init files."
+ (let ((elt (seq-find (lambda (x)
+ (eq cat (plist-get (cdr x) :category)))
+ message-completion-alist)))
+ (when elt
+ (setq message-completion-alist
+ (assoc-delete-all (car elt) message-completion-alist))
+ (push (cons (car elt) (plist-put (cdr elt) :completions compl))
+ message-completion-alist)))
+ nil)
(defcustom message-expand-name-databases
'(bbdb eudc)
@@ -8291,6 +8344,13 @@ mail-abbrev-mode-regexp
(defvar message--old-style-completion-functions nil)
+;; set completion category defaults for categories defined by
+;; message mode
+(add-to-list 'completion-category-defaults
+ '(newsgroup (styles substring partial-completion))))
+(add-to-list 'completion-category-defaults
+ '(email (styles substring partial-completion))))
+
(defun message-completion-function ()
(let ((alist message-completion-alist))
(while (and alist
@@ -8298,43 +8358,59 @@ message-completion-function
(not (mail-abbrev-in-expansion-header-p))))
(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))))))))
-
-(defun message-expand-group ()
+ (let ((recipe (cdar alist)))
+ (pcase recipe
+ ((pred functionp)
+ (if (member recipe message--old-style-completion-functions)
+ (lambda ()
+ (funcall recipe)
+ ;; 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 recipe)))
+ (if (and (eq ticks-before (buffer-chars-modified-tick))
+ (or (null data)
+ (integerp (car-safe data))))
+ data
+ (push recipe message--old-style-completion-functions)
+ ;; Completion was already performed, so just return a dummy
+ ;; function that prevents trying any further.
+ (lambda () 'completion-attempted)))))
+ (_
+ (let* ((completions (plist-get recipe :completions))
+ (beg (save-excursion
+ (re-search-backward (plist-get recipe :fieldsep-re))
+ (match-end 0)))
+ (end (point))
+ (cat (plist-get recipe :category))
+ (completion-table (if (functionp completions)
+ (funcall completions beg end)
+ completions)))
+ ;; TODO: Should we check whether completion-table has
+ ;; category metadata already, and add it when
+ ;; missing only?
+ (setq completion-table
+ (cons completion-table
+ `(metadata ((category . ,cat))))))))))))
+
+(defun message-expand-group (&optional pfx-beg pfx-end)
"Expand the group name under point."
- (let ((b (save-excursion
- (save-restriction
- (narrow-to-region
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward "^:")
- (1+ (point)))
- (point))
- (skip-chars-backward "^, \t\n") (point))))
+ (let ((b (or pfx-beg (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "^:")
+ (1+ (point)))
+ (point))
+ (skip-chars-backward "^, \t\n") (point)))))
(completion-ignore-case t)
- (e (progn (skip-chars-forward "^,\t\n ") (point)))
+ (e (or pfx-end (progn (skip-chars-forward "^,\t\n ") (point))))
(collection (when (and (boundp 'gnus-active-hashtb)
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))))
(defcustom message-expand-name-standard-ui nil
@@ -8347,14 +8423,16 @@ message-expand-name-standard-ui
:version "27.1"
:type 'boolean)
-(defun message-expand-name ()
+(defun message-expand-name (&optional pfx-beg pfx-end)
(cond (message-expand-name-standard-ui
- (let ((beg (save-excursion
- (skip-chars-backward "^\n:,") (skip-chars-forward " \t")
- (point)))
- (end (save-excursion
- (skip-chars-forward "^\n,") (skip-chars-backward " \t")
- (point))))
+ (let ((beg (or pfx-beg (save-excursion
+ (skip-chars-backward "^\n:,")
+ (skip-chars-forward " \t")
+ (point))))
+ (end (or pfx-end (save-excursion
+ (skip-chars-forward "^\n,")
+ (skip-chars-backward " \t")
+ (point)))))
(when (< beg end)
(list beg end (message--name-table (buffer-substring beg end))))))
((and (memq 'eudc message-expand-name-databases)
@@ -8372,9 +8450,6 @@ message-expand-name
(t
(expand-abbrev))))
-(add-to-list 'completion-category-defaults '(email (styles substring
- partial-completion)))
-
(defun message--bbdb-query-with-words (words)
;; FIXME: This (or something like this) should live on the BBDB side.
(when (fboundp 'bbdb-records)
@@ -8402,7 +8477,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
^ permalink raw reply related [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-20 20:59 ` Alexander Adolf
@ 2022-07-20 23:59 ` Stefan Monnier
2022-07-22 13:20 ` Alexander Adolf
2022-07-27 21:16 ` Alexander Adolf
0 siblings, 2 replies; 16+ messages in thread
From: Stefan Monnier @ 2022-07-20 23:59 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
> Why restrict it to a table? Perhaps we should allow both, functions and
> tables? Practically, that could mean checking whether the value
> satisfies `functionp`, and `funcall` it when that's the case; else use
> it as a ready-made table.
> It seems I am missing something?
A "completion table" can take several shapes, one of which is
a function. But that function isn't used like a CAPF function.
E.g. `message-expand-name` is a CAPF function whereas
(message--name-table STR) returns a completion table (implemented as a function).
[ I'll get back to you later for the rest of your message. ]
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-20 23:59 ` Stefan Monnier
@ 2022-07-22 13:20 ` Alexander Adolf
2022-07-22 13:58 ` Alexander Adolf
2022-07-27 21:16 ` Alexander Adolf
1 sibling, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-07-22 13:20 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
Stefan Monnier <monnier@iro.umontreal.ca> writes:
> [...]
> A "completion table" can take several shapes, one of which is
> a function.
> [...]
That clarifies, thanks. We're on the same page.
Now I _think_ I understood a little better where you seem to be heading.
It appears your (as of yet not explicitly described) goal is to have a
collection of message--name-table type things in message.el, and
depending on the completion context plug the corresponding one of them
into at (list beg end collection) construct, which is then returned by
message-completion-function?
One of the added values of message--name-table seems to be the
marshalling of, and the merging of results from, the different
completion sources (eudc, bbdb, and ecomplete; not mailabbrev though?).
EUDC has recently gained the ability to do multi-server queries, and
deliver the combined results from all servers, and it was hence my idea
that this marshalling/merging functionality could now conveniently be
outsourced from message.el to EUDC. There is a bbdb back-end for EUDC
already, and I have back-ends for ecomplete and mailabbrev sitting on my
hard drive. I.e. there would not be any "degradation" in terms of
end-user functionality (same set of completion candidates as before),
and additional sources like e.g. LDAP, and macOS Contacts would become
available "for free" by calling eudc-query-with-words with its new
TRY-ALL-SERVERS parameter set to t.
It would seem that quite a couple of lines of code could be "commented
out" of message.el under `(if (<= emacs-major-version 29) ...)` as a
result of such a change.
Also, message.el would no longer need to deal with any completion UI
issues, and any completion UI related code in ecomplete, and mailabbrev
would no longer be used.
Another thing to look at would seem the "harvesting" of email addresses.
Today, there is support for ecomplete in message.el. It might be just as
(more?) appropriate to provide a new hook for this? Along the lines of
what is now in message-put-addresses-in-ecomplete, instead of a
hard-coded call to ecomplete, user-provided hook functions could be
called for each header.
At the end of the day, message.el would be completely independent of
what databases people use, or don't use. It would interface with EUDC
only, and leave "address harvesting" to user functions called from a new
message send hook.
Many thanks and looking forward to your thoughts,
--alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-22 13:20 ` Alexander Adolf
@ 2022-07-22 13:58 ` Alexander Adolf
0 siblings, 0 replies; 16+ messages in thread
From: Alexander Adolf @ 2022-07-22 13:58 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
It's too hot to think today. I deserve to correct myself in two points.
Alexander Adolf <alexander.adolf@condition-alpha.com> writes:
> [...] I.e. there would not be any "degradation" in terms of
> end-user functionality (same set of completion candidates as before),
> and additional sources like e.g. LDAP, and macOS Contacts would become
> available "for free" by calling eudc-query-with-words with its new
> TRY-ALL-SERVERS parameter set to t.
Nope.
Instead of eudc-query-with-words, the call would go to
eudc-capf-message-expand-name from eudc-capf.el, of course. I'd add two
new, optional parameters BEG and END to eudc-capf-message-expand-name,
so the prefix bounds can be passed down from message.el.
> It would seem that quite a couple of lines of code could be "commented
> out" of message.el under `(if (<= emacs-major-version 29) ...)` as a
> result of such a change.
> [...]
That doesn't seem quite right either.
Unless we're trying to plug a new message.el into an old set of lisp,
the code can simply be removed from message.el.
Hope that clarifies,
--alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-20 23:59 ` Stefan Monnier
2022-07-22 13:20 ` Alexander Adolf
@ 2022-07-27 21:16 ` Alexander Adolf
2022-08-17 2:45 ` Stefan Monnier
1 sibling, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-07-27 21:16 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 229 bytes --]
Hello Stefan,
I have updated the patch I sent before. It had two extra parentheses
(now fixed), and the splicing of the metadata into the completion table
was broke (now commented out). You could run this now if you wanted to.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Refactoring-Message-Completion-Alist.patch --]
[-- Type: text/x-patch, Size: 11620 bytes --]
From 68ee0fba5d939d1056f7803e886bda6b834bf316 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 1/2] 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, add completion category metadata from
message-completion-alist instead of hard coded values (FIXME), use
regex from message-completion-alist to determine prefix
(message-completion-alist-set-completions): new function to help in
writing user init files
(message-expand-group): new optional parameters to receive bounds from
message-completion-function
(message-expand-name): new optional parameters to receive bounds from
message-completion-function
---
lisp/gnus/message.el | 183 +++++++++++++++++++++++++++++++------------
1 file changed, 133 insertions(+), 50 deletions(-)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 00a27fb5f5..07abab4396 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))
@@ -8243,14 +8242,68 @@ 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 newsgroup
+ :fieldsep-re "\\([:,]\\|^\\)[ \t]*"
+ :completions ,#'message-expand-group))
+ (,message-email-recipient-header-regexp . (:category email
+ :fieldsep-re "\\([:,]\\|^\\)[ \t]*"
+ :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', and `completion-styles'.
+
+:fieldsep-re
+
+ The regular expression to use when scanning backwards in the
+ buffer. All text between point, and any preceding text
+ matching this regular expression, will be used as the prefix
+ for finding completion candidates.
+
+: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)"))))
+
+(defun message-completion-alist-set-completions (cat compl)
+ "Set the completion function for category CAT to COMPL.
+Modifies the value of `message-completion-alist'. This is a
+convenience function for use in init files."
+ (let ((elt (seq-find (lambda (x)
+ (eq cat (plist-get (cdr x) :category)))
+ message-completion-alist)))
+ (when elt
+ (setq message-completion-alist
+ (assoc-delete-all (car elt) message-completion-alist))
+ (push (cons (car elt) (plist-put (cdr elt) :completions compl))
+ message-completion-alist)))
+ nil)
(defcustom message-expand-name-databases
'(bbdb eudc)
@@ -8290,6 +8343,13 @@ mail-abbrev-mode-regexp
(defvar message--old-style-completion-functions nil)
+;; set completion category defaults for categories defined by
+;; message mode
+(add-to-list 'completion-category-defaults
+ '(newsgroup (styles substring partial-completion)))
+(add-to-list 'completion-category-defaults
+ '(email (styles substring partial-completion)))
+
(defun message-completion-function ()
(let ((alist message-completion-alist))
(while (and alist
@@ -8297,43 +8357,62 @@ message-completion-function
(not (mail-abbrev-in-expansion-header-p))))
(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))))))))
-
-(defun message-expand-group ()
+ (let ((recipe (cdar alist)))
+ (pcase recipe
+ ((pred functionp)
+ (if (member recipe message--old-style-completion-functions)
+ (lambda ()
+ (funcall recipe)
+ ;; 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 recipe)))
+ (if (and (eq ticks-before (buffer-chars-modified-tick))
+ (or (null data)
+ (integerp (car-safe data))))
+ data
+ (push recipe message--old-style-completion-functions)
+ ;; Completion was already performed, so just return a dummy
+ ;; function that prevents trying any further.
+ (lambda () 'completion-attempted)))))
+ (_
+ (let* ((completions (plist-get recipe :completions))
+ (beg (save-excursion
+ (re-search-backward (plist-get recipe :fieldsep-re))
+ (match-end 0)))
+ (end (point))
+ (cat (plist-get recipe :category))
+ completion-table)
+ (setq completion-table (if (functionp completions)
+ (funcall completions beg end)
+ completions))
+ ;; TODO: Should we check whether completion-table has
+ ;; category metadata already, and add it when
+ ;; missing only?
+ ;; (setq completion-table
+ ;; (cons completion-table
+ ;; `(metadata ((category . ,cat)))))
+ ;; (message "completion-table = %s" completion-table)
+ completion-table)))))))
+
+(defun message-expand-group (&optional pfx-beg pfx-end)
"Expand the group name under point."
- (let ((b (save-excursion
- (save-restriction
- (narrow-to-region
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward "^:")
- (1+ (point)))
- (point))
- (skip-chars-backward "^, \t\n") (point))))
+ (let ((b (or pfx-beg (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "^:")
+ (1+ (point)))
+ (point))
+ (skip-chars-backward "^, \t\n") (point)))))
(completion-ignore-case t)
- (e (progn (skip-chars-forward "^,\t\n ") (point)))
+ (e (or pfx-end (progn (skip-chars-forward "^,\t\n ") (point))))
(collection (when (and (boundp 'gnus-active-hashtb)
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))))
(defcustom message-expand-name-standard-ui nil
@@ -8346,14 +8425,16 @@ message-expand-name-standard-ui
:version "27.1"
:type 'boolean)
-(defun message-expand-name ()
+(defun message-expand-name (&optional pfx-beg pfx-end)
(cond (message-expand-name-standard-ui
- (let ((beg (save-excursion
- (skip-chars-backward "^\n:,") (skip-chars-forward " \t")
- (point)))
- (end (save-excursion
- (skip-chars-forward "^\n,") (skip-chars-backward " \t")
- (point))))
+ (let ((beg (or pfx-beg (save-excursion
+ (skip-chars-backward "^\n:,")
+ (skip-chars-forward " \t")
+ (point))))
+ (end (or pfx-end (save-excursion
+ (skip-chars-forward "^\n,")
+ (skip-chars-backward " \t")
+ (point)))))
(when (< beg end)
(list beg end (message--name-table (buffer-substring beg end))))))
((and (memq 'eudc message-expand-name-databases)
@@ -8371,9 +8452,6 @@ message-expand-name
(t
(expand-abbrev))))
-(add-to-list 'completion-category-defaults '(email (styles substring
- partial-completion)))
-
(defun message--bbdb-query-with-words (words)
;; FIXME: This (or something like this) should live on the BBDB side.
(when (fboundp 'bbdb-records)
@@ -8401,7 +8479,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.1
[-- Attachment #3: Type: text/plain, Size: 888 bytes --]
The second patch builds on the first one, and is somewhat "heavier". It
removes all ecomplete, and mailabbrev stuff, and all completion UI code.
I have also removed message-expand-name, and message--name-table, and
instead am calling out to EUDC. EUDC is enhanced by two new backends for
ecomplete, and mailabbrev. Thus, in terms of functionality, end users
should see no difference. To use the new EUDC back-ends you'll need to
do one or both of:
(require 'eudcb-ecomplete)
(add-to-list 'eudc-server-hotlist '("localhost" . ecomplete))
(require 'eudcb-mailabbrev)
(add-to-list 'eudc-server-hotlist '("localhost" . mailabbrev))
I have also added a new hook for email address snarfing, so that there
is now generic mechanisms for this, too. Perhaps a new function for in
ecomplete would be helpful, which can readily be added to the new
snarfing hook. I'll have a look to that soon.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Use-completion-at-point-and-EUDC-for-email-address-c.patch --]
[-- Type: text/x-patch, Size: 25163 bytes --]
From 7042e888454a935a905df4126063f10e330ddfea Mon Sep 17 00:00:00 2001
From: Alexander Adolf <alexander.adolf@condition-alpha.com>
Date: Mon, 25 Jul 2022 16:33:11 +0200
Subject: [PATCH 2/2] Use completion-at-point and EUDC for email address
completion
* lisp/gnus/message.el: remove all ecomplete, and mailabbrev related
code; remove all completion UI code; use completion-at-point for email
address completion only
(message-completion-alist): make EUDC the default provider for email
address completion candidates
(message-mail-address-snarf-hook): new generic mechanism to capture
email addresses into databases used by the user
* lisp/net/eudc-capf.el (eudc-capf-message-expand-name): new optional
parameters for prefix beginning and end
* lisp/net/eudcb-ecomplete.el: new file; ecomplete back-end for EUDC
* lisp/net/eudcb-mailabbrev.el: new file; mailabbrev back-end for EUDC
---
lisp/gnus/message.el | 252 +++++++++--------------------------
lisp/net/eudc-capf.el | 15 +--
lisp/net/eudcb-ecomplete.el | 110 +++++++++++++++
lisp/net/eudcb-mailabbrev.el | 100 ++++++++++++++
4 files changed, 278 insertions(+), 199 deletions(-)
create mode 100644 lisp/net/eudcb-ecomplete.el
create mode 100644 lisp/net/eudcb-mailabbrev.el
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 07abab4396..528053ef8a 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -51,6 +51,7 @@
(require 'yank-media)
(require 'mailcap)
(require 'sendmail)
+(require 'eudc-capf)
(autoload 'mailclient-send-it "mailclient")
@@ -1385,26 +1386,13 @@ message-send-method-alist
PREDICATE returns non-nil. FUNCTION is called with one parameter --
the prefix.")
-(defcustom message-mail-alias-type 'abbrev
- "What alias expansion type to use in Message buffers.
-The default is `abbrev', which uses mailabbrev. `ecomplete' uses
-an electric completion mode. nil switches mail aliases off.
-This can also be a list of values."
- :group 'message
- :link '(custom-manual "(message)Mail Aliases")
- :type '(choice (const :tag "Use Mailabbrev" abbrev)
- (const :tag "Use ecomplete" ecomplete)
- (const :tag "No expansion" nil)))
-
-(defcustom message-self-insert-commands '(self-insert-command)
- "List of `self-insert-command's used to trigger ecomplete.
-When one of those commands is invoked to enter a character in To or Cc
-header, ecomplete will suggest the candidates of recipients (see also
-`message-mail-alias-type'). If you use some tool to enter non-ASCII
-text and it replaces `self-insert-command' with the other command, e.g.
-`egg-self-insert-command', you may want to add it to this list."
- :group 'message-various
- :type '(repeat function))
+(make-obsolete-variable 'message-mail-alias-type
+ "use `eudc-server-hotlist' and `message-mail-address-snarf-hook' instead."
+ "29.1")
+
+(make-obsolete-variable 'message-self-insert-commands
+ "now uses `completion-at-point'."
+ "29.1")
(defcustom message-auto-save-directory
(if (file-writable-p message-directory)
@@ -1813,6 +1801,21 @@ message-sent-hook
:group 'message-various
:type 'hook)
+(defcustom message-mail-address-snarf-hook nil
+ "Hook run to snarf email addresses.
+This hook is run just after the message was sent as mail.
+
+The functions on this hook are called once for each header line
+where email addresses were found. They take a single argument, a
+list of cons cells as returned by `mail-header-parse-addresses'.
+Each cons cell corresponds to an email address found. The car of
+each cons cell contains the email address. When the cons cell
+has a cdr, and its value is not nil, it contains the phrase or
+comment part as detected by `mail-header-parse-addresses'."
+ :version "29.1"
+ :group 'message-various
+ :type 'hook)
+
(defvar message-send-coding-system 'binary
"Coding system to encode outgoing mail.")
@@ -1934,7 +1937,8 @@ message-draft-article
(defvar message-mime-part nil)
(defvar message-posting-charset nil)
(defvar message-inserted-headers nil)
-(defvar message-inhibit-ecomplete nil)
+(make-obsolete-variable 'message-inhibit-ecomplete 'eudc-server-hotlist
+ "29.1")
;; Byte-compiler warning
(defvar gnus-active-hashtb)
@@ -2942,9 +2946,7 @@ message-mode-map
"C-c C-p" #'message-insert-screenshot
"C-a" #'message-beginning-of-line
- "TAB" #'message-tab
-
- "M-n" #'message-display-abbrev)
+ "TAB" #'message-tab)
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@@ -3094,9 +3096,6 @@ message-strip-forbidden-properties
"Strip forbidden properties between BEGIN and END, ignoring the third arg.
This function is intended to be called from `after-change-functions'.
See also `message-forbidden-properties'."
- (when (and (message-mail-alias-type-p 'ecomplete)
- (memq this-command message-self-insert-commands))
- (message-display-abbrev))
(when (and message-strip-special-text-properties
(message-tamago-not-in-use-p begin))
(let ((inhibit-read-only t))
@@ -3174,12 +3173,7 @@ message-mode
;; Mmmm... Forbidden properties...
(add-hook 'after-change-functions #'message-strip-forbidden-properties
nil 'local)
- ;; Allow mail alias things.
- (cond
- ((message-mail-alias-type-p 'abbrev)
- (mail-abbrevs-setup))
- ((message-mail-alias-type-p 'ecomplete)
- (ecomplete-setup)))
+ ;; email address completion uses completion-at-point
(add-hook 'completion-at-point-functions #'message-completion-function nil t)
(unless buffer-file-name
(message-set-auto-save-file-name))
@@ -4440,10 +4434,11 @@ message-send
(save-excursion
(run-hooks 'message-sent-hook))
(message "Sending...done")
- ;; Do ecomplete address snarfing.
- (when (and (message-mail-alias-type-p 'ecomplete)
- (not message-inhibit-ecomplete))
- (message-put-addresses-in-ecomplete))
+ ;; Do address snarfing.
+ (dolist (header '("to" "cc" "from" "reply-to"))
+ (let* ((value (message-field-value header))
+ (parsed (mail-header-parse-addresses value)))
+ (run-hook-with-args 'message-mail-address-snarf-hook parsed)))
;; Mark the buffer as unmodified and delete auto-save.
(set-buffer-modified-p nil)
(delete-auto-save-file-if-necessary t)
@@ -8017,8 +8012,7 @@ message-resend
;; message has already been encoded.
(let ((case-fold-search t))
(re-search-forward "^mime-version:" nil t)))
- (message-inhibit-ecomplete t)
- ;; We don't want smtpmail.el to encode anything, either.
+ ;; We don't want smtpmail.el to encode anything, either.
(sendmail-coding-system 'raw-text)
(select-safe-coding-system-function nil)
message-required-mail-headers
@@ -8247,7 +8241,7 @@ message-completion-alist
:completions ,#'message-expand-group))
(,message-email-recipient-header-regexp . (:category email
:fieldsep-re "\\([:,]\\|^\\)[ \t]*"
- :completions ,#'message-expand-name)))
+ :completions ,#'eudc-capf-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),
@@ -8305,12 +8299,9 @@ message-completion-alist-set-completions
message-completion-alist)))
nil)
-(defcustom message-expand-name-databases
- '(bbdb eudc)
- "List of databases to try for name completion (`message-expand-name').
-Each element is a symbol and can be `bbdb' or `eudc'."
- :group 'message
- :type '(set (const bbdb) (const eudc)))
+(make-obsolete-variable 'message-expand-name-databases
+ "use `eudc-server-hotlist' instead."
+ "29.1")
(defcustom message-tab-body-function nil
"Function to execute when `message-tab' (TAB) is executed in the body.
@@ -8415,97 +8406,19 @@ message-expand-group
(when collection
(list b e collection))))
-(defcustom message-expand-name-standard-ui nil
- "If non-nil, use the standard completion UI in `message-expand-name'.
-E.g. this means it will obey `completion-styles' and other such settings.
+(make-obsolete-variable 'message-expand-name-standard-ui
+ "the UI is provided by `completion-at-point'."
+ "29.1")
-If this variable is non-nil and `message-mail-alias-type' is
-`ecomplete', `message-self-insert-commands' should probably be
-set to nil."
- :version "27.1"
- :type 'boolean)
+(make-obsolete 'message-expand-name 'eudc-capf-expand-name
+ "29.1")
-(defun message-expand-name (&optional pfx-beg pfx-end)
- (cond (message-expand-name-standard-ui
- (let ((beg (or pfx-beg (save-excursion
- (skip-chars-backward "^\n:,")
- (skip-chars-forward " \t")
- (point))))
- (end (or pfx-end (save-excursion
- (skip-chars-forward "^\n,")
- (skip-chars-backward " \t")
- (point)))))
- (when (< beg end)
- (list beg end (message--name-table (buffer-substring beg end))))))
- ((and (memq 'eudc message-expand-name-databases)
- (boundp 'eudc-protocol)
- eudc-protocol)
- (eudc-expand-inline))
- ((and (memq 'bbdb message-expand-name-databases)
- (fboundp 'bbdb-complete-name))
- (let ((starttick (buffer-modified-tick)))
- (or (bbdb-complete-name)
- ;; Apparently, bbdb-complete-name can return nil even when
- ;; completion took place. So let's double check the buffer was
- ;; not modified.
- (/= starttick (buffer-modified-tick)))))
- (t
- (expand-abbrev))))
-
-(defun message--bbdb-query-with-words (words)
- ;; FIXME: This (or something like this) should live on the BBDB side.
- (when (fboundp 'bbdb-records)
- (require 'bbdb) ;FIXME: `bbdb-records' is incorrectly autoloaded!
- (bbdb-records) ;Make sure BBDB and its database is initialized.
- (defvar bbdb-hashtable)
- (declare-function bbdb-record-mail "bbdb" (record))
- (declare-function bbdb-dwim-mail "bbdb-com" (record &optional mail))
- (declare-function bbdb-completion-predicate "bbdb-com" (key records))
- (let ((records '())
- (responses '()))
- (dolist (word words)
- (dolist (c (all-completions word bbdb-hashtable
- #'bbdb-completion-predicate))
- (dolist (record (gethash c bbdb-hashtable))
- (cl-pushnew record records))))
- (dolist (record records)
- (dolist (mail (bbdb-record-mail record))
- (push (bbdb-dwim-mail record mail) responses)))
- responses)))
-
-(defun message--name-table (orig-string)
- (let ((orig-words (split-string orig-string "[ \t]+"))
- eudc-responses
- bbdb-responses)
- (lambda (string pred action)
- (pcase action
- ('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
- (when (and (memq 'eudc message-expand-name-databases)
- (boundp 'eudc-protocol)
- eudc-protocol)
- (setq eudc-responses (eudc-query-with-words orig-words)))
- (when (memq 'bbdb message-expand-name-databases)
- (setq bbdb-responses (message--bbdb-query-with-words orig-words)))
- (ecomplete-setup)
- (setq orig-words nil))
- (let ((candidates
- ;; FIXME: Add `expand-abbrev'!
- (append (all-completions string eudc-responses pred)
- (all-completions string bbdb-responses pred)
- (when (and (bound-and-true-p ecomplete-database)
- (fboundp 'ecomplete-completion-table))
- (all-completions string
- (ecomplete-completion-table 'mail)
- pred)))))
- (if action candidates (try-completion string candidates))))))))
+(make-obsolete 'message--bbdb-query-with-words
+ "use `eudc-server-hotlist' instead."
+ "29.1")
+
+(make-obsolete 'message--name-table 'eudc-capf-expand-name
+ "29.1")
;;; Help stuff.
@@ -8708,62 +8621,19 @@ message-hide-header-p
(not result)
result)))
-(declare-function ecomplete-add-item "ecomplete" (type key text))
-(declare-function ecomplete-save "ecomplete" ())
-
-(defun message-put-addresses-in-ecomplete ()
- (require 'ecomplete)
- (dolist (header '("to" "cc" "from" "reply-to"))
- (let ((value (message-field-value header)))
- (dolist (string (mail-header-parse-addresses value 'raw))
- (setq string
- (string-replace
- "\n" ""
- (replace-regexp-in-string "^ +\\| +$" "" string)))
- (ecomplete-add-item 'mail (car (mail-header-parse-address string))
- string))))
- (ecomplete-save))
-
-(autoload 'ecomplete-display-matches "ecomplete")
-
-(defun message--in-tocc-p ()
- (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? ))
- (message-point-in-header-p)
- (save-excursion
- (beginning-of-line)
- (while (and (memq (char-after) '(?\t ? ))
- (zerop (forward-line -1))))
- (looking-at "To:\\|Cc:"))))
-
-(defun message-display-abbrev (&optional choose)
- "Display the next possible abbrev for the text before point."
- (interactive (list t) message-mode)
- (when (message--in-tocc-p)
- (let* ((end (point))
- (start (save-excursion
- (and (re-search-backward "[\n\t ]" nil t)
- (1+ (point)))))
- (word (when start (buffer-substring start end)))
- (match (when (and word
- (not (zerop (length word))))
- (ecomplete-display-matches 'mail word choose))))
- (when (and choose match)
- (delete-region start end)
- (insert match)))))
-
-(defun message-ecomplete-capf ()
- "Return completion data for email addresses in Ecomplete.
-Meant for use on `completion-at-point-functions'."
- (when (and (bound-and-true-p ecomplete-database)
- (fboundp 'ecomplete-completion-table)
- (message--in-tocc-p))
- (let ((end (save-excursion
- (skip-chars-forward "^, \t\n")
- (point)))
- (start (save-excursion
- (skip-chars-backward "^, \t\n")
- (point))))
- `(,start ,end ,(ecomplete-completion-table 'mail)))))
+(make-obsolete 'message-put-addresses-in-ecomplete 'message-mail-address-snarf-hook
+ "29.1")
+
+(make-obsolete 'message--in-tocc-p 'message-completion-function
+ "29.1")
+
+(make-obsolete 'message-display-abbrev
+ "now uses `completion-at-point'."
+ "29.1")
+
+(make-obsolete 'message-ecomplete-capf
+ "use `eudcb-ecomplete' in `eudc-server-hotlist' instead."
+ "29.1")
;; To send pre-formatted letters like the example below, you can use
;; `message-send-form-letter':
diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el
index 92f0c80493..884d6e371f 100644
--- a/lisp/net/eudc-capf.el
+++ b/lisp/net/eudc-capf.el
@@ -107,21 +107,20 @@ eudc-capf-complete
(eudc-capf-message-expand-name)))
;;;###autoload
-(defun eudc-capf-message-expand-name ()
+(defun eudc-capf-message-expand-name (&optional pfx-beg pfx-end)
"Email address completion function for `message-completion-alist'.
-When this function is added to `message-completion-alist',
-replacing any existing entry for `message-expand-name' there,
-with an appropriate regular expression such as for example
+When this function is added to `message-completion-alist', with
+an appropriate regular expression such as for example
`message-email-recipient-header-regexp', then EUDC will be
queried for email addresses, and the results delivered to
`completion-at-point'."
(if (or eudc-server eudc-server-hotlist)
(progn
- (let* ((beg (save-excursion
- (re-search-backward "\\([:,]\\|^\\)[ \t]*")
- (match-end 0)))
- (end (point))
+ (let* ((beg (or pfx-beg (save-excursion
+ (re-search-backward "\\([:,]\\|^\\)[ \t]*")
+ (match-end 0))))
+ (end (or pfx-end (point)))
(prefix (save-excursion (buffer-substring-no-properties beg end))))
(list beg end
(completion-table-with-cache
diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el
new file mode 100644
index 0000000000..6d12ab9231
--- /dev/null
+++ b/lisp/net/eudcb-ecomplete.el
@@ -0,0 +1,110 @@
+;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 condition-alpha.com
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the ecomplete package as
+;; an EUDC data source.
+
+;;; Usage:
+;; To load the library, first `require' it:
+;;
+;; (require 'eudcb-ecomplete)
+;;
+;; In the simplest case then just use:
+;;
+;; (eudc-ecomplete-set-server "localhost")
+;;
+;; When using `eudc-server-hotlist', instead use:
+;;
+;; (add-to-list 'eudc-server-hotlist '("localhost" . ecomplete))
+
+;;; Code:
+
+(require 'eudc)
+(require 'ecomplete)
+(require 'mail-parse)
+
+(defvar eudc-ecomplete-attributes-translation-alist
+ '((email . mail))
+ "See `eudc-protocol-attributes-translation-alist'.
+The back-end-specific attribute names are used as the \"type\" of
+entry when searching, and they must hence match the types you use
+in your ecmompleterc database file.")
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-ecomplete-query-internal
+ 'ecomplete)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ 'eudc-ecomplete-attributes-translation-alist
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'ecomplete)
+
+(defun eudc-ecomplete-query-internal (query &optional _return-attrs)
+ "Query `ecomplete' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-ecomplete-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`ecomplete-database'.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (ecomplete-setup)
+ (let ((email-attr (car (eudc-translate-attribute-list '(email))))
+ result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (matches (ecomplete-get-matches attr value)))
+ (when matches
+ (dolist (match (split-string (string-trim (substring-no-properties
+ matches))
+ "[\n\r]"))
+ ;; special case email: try to decompose
+ (let* ((decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if (and decoded (eq attr email-attr))
+ ;; email could be decomposed, push individual fields
+ (push `((,attr . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; else, just forward the value as-is
+ (push (list (cons attr match)) result)))))))
+ result))
+
+(defun eudc-ecomplete-set-server (dummy)
+ "Set the EUDC server to `ecomplete'.
+The server in DUMMY is not actually used, since this backend
+always and implicitly uses the ecomplete package in the current
+Emacs instance running on the local host."
+ (interactive)
+ (eudc-set-server dummy 'ecomplete)
+ (message "[eudc] ecomplete server selected"))
+
+(eudc-register-protocol 'ecomplete)
+
+(provide 'eudcb-ecomplete)
+
+;;; eudcb-ecomplete.el ends here
diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el
new file mode 100644
index 0000000000..816ce7b1e9
--- /dev/null
+++ b/lisp/net/eudcb-mailabbrev.el
@@ -0,0 +1,100 @@
+;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 condition-alpha.com
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the mailabbrev package as
+;; an EUDC data source.
+
+;;; Usage:
+;; To load the library, first `require' it:
+;;
+;; (require 'eudcb-mailabbrev)
+;;
+;; In the simplest case then just use:
+;;
+;; (eudc-mailabbrev-set-server "localhost")
+;;
+;; When using `eudc-server-hotlist', instead use:
+;;
+;; (add-to-list 'eudc-server-hotlist '("localhost" . mailabbrev))
+
+;;; Code:
+
+(require 'eudc)
+(require 'mailabbrev)
+(require 'mail-parse)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-mailabbrev-query-internal
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'mailabbrev)
+
+(defun eudc-mailabbrev-query-internal (query &optional _return-attrs)
+ "Query `mailabbrev' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-mailabbrev-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`mailabbrev-database'.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (mail-abbrevs-setup)
+ (let (result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (match (symbol-value (intern-soft value mail-abbrevs))))
+ (when (and match
+ (memq attr '(email firstname name)))
+ ;; try to decompose email construct
+ (let* ((decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if decoded
+ ;; decoding worked, push individual fields
+ (push `((email . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; else, just forward the value as-is
+ (push (list (cons 'email match)) result))))))
+ result))
+
+(defun eudc-mailabbrev-set-server (dummy)
+ "Set the EUDC server to `mailabbrev'.
+The server in DUMMY is not actually used, since this backend
+always and implicitly uses the mailabbrev package in the current
+Emacs instance running on the local host."
+ (interactive)
+ (eudc-set-server dummy 'mailabbrev)
+ (message "[eudc] mailabbrev server selected"))
+
+(eudc-register-protocol 'mailabbrev)
+
+(provide 'eudcb-mailabbrev)
+
+;;; eudcb-mailabbrev.el ends here
--
2.37.1
[-- Attachment #5: Type: text/plain, Size: 204 bytes --]
I haven't invested any time in scratching my head about a NEWS entry, or
any modifications to the texi documentation, but wanted to get you view
first.
Looking forward to your thoughts,
--alexander
^ permalink raw reply related [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
@ 2022-08-13 13:11 Alexander Adolf
2022-08-17 1:54 ` Stefan Monnier
0 siblings, 1 reply; 16+ messages in thread
From: Alexander Adolf @ 2022-08-13 13:11 UTC (permalink / raw)
To: emacs-devel
Hello,
it's been a while since the last update on this subject. I have chatted
with Thomas, the maintainer of EUDC, and he stated a preference for
having the two new EUDC back-ends (one for ecomplete, and one for
mailabbrev) in a separate patch series.
I will thus separate these two things out into a separate proposal, and
will update the "message completion refactoring proposal" accordingly.
Above and beyond that, I still need to do the following things for the
present "message completion refactoring proposal":
- figure out, and implement how to add completion category metadata to
completion tables;
- write a NEWS entry;
- update the texi manual for message.
Cheers,
--alexander
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-08-13 13:11 Alexander Adolf
@ 2022-08-17 1:54 ` Stefan Monnier
0 siblings, 0 replies; 16+ messages in thread
From: Stefan Monnier @ 2022-08-17 1:54 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
> - figure out, and implement how to add completion category metadata to
> completion tables;
We really should provide a `completion-table-with-metadata` function to
do that, but basically it can start with something like:
(defun completion-table-with-metadata (table metadata)
(lambda (string pred action)
(if (eq action 'metadata)
metadata
(complete-with-action action table string pred))))
[ You may want to make spice it up in case you want to handle the case
where `table` already provides some metadata which you'd then want
to augment. ]
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Thoughts on Refactoring In-Buffer Completion In message.el
2022-07-27 21:16 ` Alexander Adolf
@ 2022-08-17 2:45 ` Stefan Monnier
0 siblings, 0 replies; 16+ messages in thread
From: Stefan Monnier @ 2022-08-17 2:45 UTC (permalink / raw)
To: Alexander Adolf; +Cc: emacs-devel
> +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'.
Right.
> +When RECIPE is a plist, the stored properties are used to control
[ Remove "stored" and "are used to". ]
> +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', and `completion-styles'.
> +
> +:fieldsep-re
> +
> + The regular expression to use when scanning backwards in the
> + buffer. All text between point, and any preceding text
> + matching this regular expression, will be used as the prefix
> + for finding completion candidates.
I don't think we should limit ourselves to completion based on a prefix.
IOW, when I have:
To: al<!>adol
where <!> represents the position of the cursor, we should consider
"aldol" as the string we're trying to complete (knowing that we're
trying to complete it from the middle). `completion-at-point-functions`
already supports this just fine. All we have to do is to look both
backward and forward to find the beginning and the end, rather than only
looking backward to find the beginning and always using `point` as
the end.
You currently use "\\([:,]\\|^\\)[ \t]*" as the regexp, but the ":" is
redundant because the code should already take the end of header's
regexp match as a limit on the lefthand side. And we should strip the
spaces by hand anyway, so the regexp should just be "," (and we should
default to that if the property is not provided, as will presumably
always be the case).
> +:completions
> +
> + The function that provides completions, and that obeys the
> + same rules as those of `completion-at-point-functions'.
I think you forgot to update this part of the docstring: it should say
that this is a completion table rather than a function that obeys the
rules of `completion-at-point-functions`.
> +(defun message-completion-alist-set-completions (cat compl)
> + "Set the completion function for category CAT to COMPL.
> +Modifies the value of `message-completion-alist'. This is a
> +convenience function for use in init files."
Hmm... I'm not sure it's really convenient. IIUC this is intended for
users to say "use EUDC for email completions instead"? If so, maybe we
should support this more directly so users only need to set a simple
variable to get that result?
[ Then again, we already have `message-expand-name-databases` for that,
so maybe you have some other use case in mind? ]
> + (let* ((completions (plist-get recipe :completions))
> + (beg (save-excursion
> + (re-search-backward (plist-get recipe :fieldsep-re))
Usually properties in plists are optional. Admittedly, it's not always
the case, but I'd recommend signaling more explicit errors when
a property is missing. Here if `:fieldsep-re` is missing we'll just get
an error about nil not being a string without any hint where this nil
comes from (and the naive users may end up in a wild goose chase if
they try to search the web for "how to fix: wrong-type-argument
stringp nil").
IOW I'd do something like
(or (plist-get recipe :completions)
(error "Missing :completions in %S" recipe))
Same for `:fieldsep-re` (not for :category since a nil category seems
like a fine default), unless you make it default to ",".
> + (match-end 0)))
> + (end (point))
> + (cat (plist-get recipe :category))
> + completion-table)
> + (setq completion-table (if (functionp completions)
> + (funcall completions beg end)
> + completions))
Hmm... why do you call `completions` here? Just use the function itself
as the completion table. The completion machinery will call it
if/when/as needed.
> -(defun message-expand-group ()
> +(defun message-expand-group (&optional pfx-beg pfx-end)
IIUC the completion table for newgroups should be simply
`gnus-active-hashtb` instead of #'message-expand-group (which is not
a valid completion table).
`message-expand-group` should then be marked as obsolete.
> -(defun message-expand-name ()
> +(defun message-expand-name (&optional pfx-beg pfx-end)
> (cond (message-expand-name-standard-ui
> - (let ((beg (save-excursion
> - (skip-chars-backward "^\n:,") (skip-chars-forward " \t")
> - (point)))
> - (end (save-excursion
> - (skip-chars-forward "^\n,") (skip-chars-backward " \t")
> - (point))))
> + (let ((beg (or pfx-beg (save-excursion
> + (skip-chars-backward "^\n:,")
> + (skip-chars-forward " \t")
> + (point))))
> + (end (or pfx-end (save-excursion
> + (skip-chars-forward "^\n,")
> + (skip-chars-backward " \t")
> + (point)))))
> (when (< beg end)
> (list beg end (message--name-table (buffer-substring beg end))))))
> ((and (memq 'eudc message-expand-name-databases)
Again, this is not a completion table. A completion table for names
could be:
(completion-table-dynamic #'message--name-table)
or maybe
(completion-table-with-cache #'message--name-table)
> @@ -8401,7 +8479,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)))))))
This is pretty hideous. Better not do that, and let the other
(currently commented out) part of the code add the metadata from the
plist when we already have that plist info at hand.
> I have also removed message-expand-name, and message--name-table, and
> instead am calling out to EUDC. EUDC is enhanced by two new backends for
> ecomplete, and mailabbrev. Thus, in terms of functionality, end users
> should see no difference. To use the new EUDC back-ends you'll need to
> do one or both of:
>
> (require 'eudcb-ecomplete)
> (add-to-list 'eudc-server-hotlist '("localhost" . ecomplete))
>
> (require 'eudcb-mailabbrev)
> (add-to-list 'eudc-server-hotlist '("localhost" . mailabbrev))
IOW users *will* see a (bad) difference because their setup will not
work as before until they add those lines to their init file :-(
> +(defcustom message-mail-address-snarf-hook nil
> + "Hook run to snarf email addresses.
> +This hook is run just after the message was sent as mail.
> +
> +The functions on this hook are called once for each header line
> +where email addresses were found. They take a single argument, a
> +list of cons cells as returned by `mail-header-parse-addresses'.
The `-hook` suffix is used only for "normal hooks", i.e. hooks run by
`run-hooks`. So this should use a name that ends in `-functions`
instead, which is the suffix normally used for those so-called "abnormal
hooks", i.e. those that take a non-empty list of arguments or whose
return value is not ignored.
This hook should probably include a function for ecomplete in its
default value, so as to preserve the existing behavior.
Stefan
^ permalink raw reply [flat|nested] 16+ messages in thread
end of thread, other threads:[~2022-08-17 2:45 UTC | newest]
Thread overview: 16+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-06-23 15:26 Thoughts on Refactoring In-Buffer Completion In message.el Alexander Adolf
2022-06-25 4:35 ` Thomas Fitzsimmons
2022-06-27 15:48 ` Alexander Adolf
2022-06-25 8:22 ` Stefan Monnier
2022-06-27 16:37 ` Alexander Adolf
2022-06-28 15:49 ` Stefan Monnier
2022-07-19 21:41 ` Alexander Adolf
2022-07-19 22:13 ` Stefan Monnier
2022-07-20 20:59 ` Alexander Adolf
2022-07-20 23:59 ` Stefan Monnier
2022-07-22 13:20 ` Alexander Adolf
2022-07-22 13:58 ` Alexander Adolf
2022-07-27 21:16 ` Alexander Adolf
2022-08-17 2:45 ` Stefan Monnier
-- strict thread matches above, loose matches on Subject: below --
2022-08-13 13:11 Alexander Adolf
2022-08-17 1:54 ` Stefan Monnier
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).