[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Thoughts on Refactoring In-Buffer Completion In message.el
|
From: |
Alexander Adolf |
|
Subject: |
Re: Thoughts on Refactoring In-Buffer Completion In message.el |
|
Date: |
Wed, 20 Jul 2022 22:59:56 +0200 |
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
>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