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: Tue, 19 Jul 2022 23:41:33 +0200 Message-ID: <82e662dc46347e410c0b1d871e998b00@condition-alpha.com> References: 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="12283"; 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 Tue Jul 19 23:42:58 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 1oDuzZ-00031W-PJ for ged-emacs-devel@m.gmane-mx.org; Tue, 19 Jul 2022 23:42:57 +0200 Original-Received: from localhost ([::1]:53560 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oDuzY-0005SS-Sm for ged-emacs-devel@m.gmane-mx.org; Tue, 19 Jul 2022 17:42:56 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:60398) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oDuyR-00049q-Tb for emacs-devel@gnu.org; Tue, 19 Jul 2022 17:41:47 -0400 Original-Received: from smtprelay01.ispgateway.de ([80.67.31.35]:39584) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oDuyM-0003bq-3j for emacs-devel@gnu.org; Tue, 19 Jul 2022 17:41:46 -0400 Original-Received: from [46.244.223.188] (helo=condition-alpha.com) by smtprelay01.ispgateway.de with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.94.2) (envelope-from ) id 1oDuyf-0003Ub-0F; Tue, 19 Jul 2022 23:42:01 +0200 In-Reply-To: X-Df-Sender: YWxleGFuZGVyLmFkb2xmQGNvbmRpdGlvbi1hbHBoYS5jb20= Received-SPF: pass client-ip=80.67.31.35; envelope-from=alexander.adolf@condition-alpha.com; helo=smtprelay01.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:292293 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Refactoring-Message-Completion-Alist.patch >From d7b4fbed9c34b7c73d59d8f709934a548c109149 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 (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 --=-=-=--