From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Alexander Adolf Newsgroups: gmane.emacs.devel Subject: Re: Thoughts on Refactoring In-Buffer Completion In message.el Date: Wed, 20 Jul 2022 22:59:56 +0200 Message-ID: <5b04a4a1f5a497f030397f6813551ad2@condition-alpha.com> References: <82e662dc46347e410c0b1d871e998b00@condition-alpha.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="37375"; mail-complaints-to="usenet@ciao.gmane.io" Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Wed Jul 20 23:01:35 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oEGp4-0009S4-QV for ged-emacs-devel@m.gmane-mx.org; Wed, 20 Jul 2022 23:01:34 +0200 Original-Received: from localhost ([::1]:53150 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oEGp3-0003KJ-Iv for ged-emacs-devel@m.gmane-mx.org; Wed, 20 Jul 2022 17:01:33 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:51308) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oEGnh-0002Rt-Dn for emacs-devel@gnu.org; Wed, 20 Jul 2022 17:00:09 -0400 Original-Received: from smtprelay05.ispgateway.de ([80.67.31.93]:13688) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oEGne-0001nr-7S for emacs-devel@gnu.org; Wed, 20 Jul 2022 17:00:09 -0400 Original-Received: from [46.244.212.11] (helo=condition-alpha.com) by smtprelay05.ispgateway.de with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.94.2) (envelope-from ) id 1oEGne-0002Mq-4W; Wed, 20 Jul 2022 23:00:06 +0200 In-Reply-To: X-Df-Sender: YWxleGFuZGVyLmFkb2xmQGNvbmRpdGlvbi1hbHBoYS5jb20= Received-SPF: pass client-ip=80.67.31.93; envelope-from=alexander.adolf@condition-alpha.com; helo=smtprelay05.ispgateway.de X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:292321 Archived-At: --=-=-= Content-Type: text/plain Hello Stefan, Many thanks for your swift response, and helpful comments! Stefan Monnier 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Refactoring-Message-Completion-Alist.patch >From 87a6778db682395f61b87b629c9553ff90059902 Mon Sep 17 00:00:00 2001 From: Alexander Adolf 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 --=-=-=--