From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Eric Abrahamsen Newsgroups: gmane.emacs.devel Subject: Re: Completion functions in message-mode Date: Wed, 25 Apr 2018 12:24:13 -0700 Message-ID: <874ljzt7he.fsf@ericabrahamsen.net> References: <20180323044822.32467.63948@vcs0.savannah.gnu.org> <20180323044823.1A70C20BDE@vcs0.savannah.gnu.org> <877eq3732w.fsf@ericabrahamsen.net> <87h8oer459.fsf_-_@ericabrahamsen.net> <87d0z2qzyg.fsf@ericabrahamsen.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1524684154 2830 195.159.176.226 (25 Apr 2018 19:22:34 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 25 Apr 2018 19:22:34 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: Stefan Monnier To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Apr 25 21:22:30 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fBPzp-0000ZA-5N for ged-emacs-devel@m.gmane.org; Wed, 25 Apr 2018 21:22:29 +0200 Original-Received: from localhost ([::1]:38670 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fBQ1u-0003gV-B5 for ged-emacs-devel@m.gmane.org; Wed, 25 Apr 2018 15:24:38 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:32977) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fBQ1l-0003gO-5g for emacs-devel@gnu.org; Wed, 25 Apr 2018 15:24:30 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fBQ1h-0007Ml-5k for emacs-devel@gnu.org; Wed, 25 Apr 2018 15:24:29 -0400 Original-Received: from [195.159.176.226] (port=36972 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fBQ1g-0007Lw-Pm for emacs-devel@gnu.org; Wed, 25 Apr 2018 15:24:25 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1fBPzX-0000Gl-U9 for emacs-devel@gnu.org; Wed, 25 Apr 2018 21:22:11 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 230 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:N9LTHHMxcmKa4SYBBtVtpxixFzA= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 195.159.176.226 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 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.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:224887 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >> My next question is, how does one "extend" a completion table? > > Not sure what you mean, but you can combine completion tables for > example by using completion-table-in-turn, or by doing something > similar to what it does. Yes, that's what I meant. >> Specifically: if c-a-p expects to receive (START END COLLECTION), should > ^^^^^^^^^^ > BTW, this is what I call "completion table". Right, that much I understood. But otherwise I was very undereducated about how completion works, and so have gone down some rabbit holes in the course of writing the attached patch, which is underwhelming for how long it took me. I doubt this will be acceptable as-is, but I do hope it will get us (me) a step closer. What I ended up with was an option, `message-expand-name-tables', that contact-management/addressbook packages can add completion tables to. This is very simple, but probably too simple: it leaves no mechanism for these packages to add extra PROPS data, like :predicate or :annotation, and also doesn't give them the opportunity to alter START and END (though maybe it shouldn't?). Anyway, for what it is, it works. It also add six spurious blank spaces to the end of any completion, at least in my test setup, but who's counting!? Hopefully we can go somewhere from here. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=message-completion.diff diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 33c5e2cedb..3a8e3f6e0f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7929,24 +7929,33 @@ message-make-tool-bar 'message-mode-map)))) message-tool-bar-map) -;;; Group name completion. +;;; Group and mail name completion. (defcustom message-newgroups-header-regexp "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups." + "Regexp matching headers that list groups." :group 'message :type 'regexp) +(defcustom message-mail-header-regexp + (concat + "^" + (regexp-opt + '("To" "Bcc" "Cc" "Resent-To" "Resent-Bcc" "Resent-Cc" + "Reply-To" "From" "Mail-Followup-To" "Mail-Copies-To" + "Disposition-Notification-To" "Return-Receipt-To")) + ":") + "Regexp matching headers that list name/mail addresses." + :group 'message + :type 'regexp + :version "27.1") + (defcustom message-completion-alist - ;; FIXME: Make it possible to use the standard completion UI. - (list (cons message-newgroups-header-regexp 'message-expand-group) - '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) - '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" - . message-expand-name) - '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" - . message-expand-name)) - "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." - :version "22.1" + (list (cons message-newgroups-header-regexp #'message-expand-group) + (cons message-mail-header-regexp #'message-expand-name)) + "Alist of (RE . FUN). +Use FUN for completion on header lines matching RE." + :version "27.1" :group 'message :type '(alist :key-type regexp :value-type function)) @@ -7956,6 +7965,19 @@ message-expand-name-databases 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 + "Add completion tables to `message-expand-name-tables' instead" + "27.1") + +(defcustom message-expand-name-tables nil + "List of tables that can be used to expand names. +Each \"table\" is a collection containing potential expansions, +and can be an alist, a plain list, a hash table, an obarray, or a +function. Multiple tables will be merged." + :group 'message + :version "27.1" + :type 'list) (defcustom message-tab-body-function nil "Function to execute when `message-tab' (TAB) is executed in the body. @@ -7982,24 +8004,16 @@ message-tab (message-tab-body-function (funcall message-tab-body-function)) (t (funcall (or (lookup-key text-mode-map "\t") (lookup-key global-map "\t") - 'indent-relative))))) + #'indent-relative))))) (defvar mail-abbrev-mode-regexp) -(defun message-completion-function () - (let ((alist message-completion-alist)) - (while (and alist - (let ((mail-abbrev-mode-regexp (caar alist))) - (not (mail-abbrev-in-expansion-header-p)))) - (setq alist (cdr alist))) - (when (cdar alist) - (let ((fun (cdar alist))) - ;; Even if completion fails, return a non-nil value, so as to avoid - ;; falling back to message-tab-body-function. - (lambda () (funcall fun) 'completion-attempted))))) +(defvar message--old-style-completion-functions nil) -(defun message-expand-group () - "Expand the group name under point." +(defsubst message-header-completion-bounds () + "Return the bounds of header input for completion. +Searches back for either the end of header or the nearest comma, +and forward for either the nearest comma or EOL." (let ((b (save-excursion (save-restriction (narrow-to-region @@ -8009,36 +8023,57 @@ message-expand-group (1+ (point))) (point)) (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) - (e (progn (skip-chars-forward "^,\t\n ") (point))) - group collection) - (when (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb) - (mapatoms - (lambda (symbol) - (setq group (symbol-name symbol)) - (push (if (string-match "[^\000-\177]" group) - (gnus-group-decoded-name group) - group) - collection)) - gnus-active-hashtb)) - (completion-in-region b e collection))) + (e (progn (skip-chars-forward "^,\t\n ") (point)))) + (cons b e))) + +(defun message-completion-function () + "Possibly complete a group name or mail address. +Check if point is in an appropriate header for completion, +otherwise return nil." + (let ((alist message-completion-alist)) + (while (and alist + (let ((mail-abbrev-mode-regexp (caar alist))) + (not (mail-abbrev-in-expansion-header-p)))) + (setq alist (cdr alist))) + (when (cdar alist) + (let ((fun (cdar alist)) + (completion-ignore-case t)) + (if (member fun message--old-style-completion-functions) + ;; Even if completion fails, return a non-nil value, so as to avoid + ;; falling back to message-tab-body-function. + (lambda () (funcall fun) '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 () + "Return group completion from `gnus-active-hashtb'." + (pcase-let ((`(,b . ,e) (message-header-completion-bounds))) + (let (collection group) + (when (and (boundp 'gnus-active-hashtb) + gnus-active-hashtb) + (mapatoms + (lambda (symbol) + (setq group (symbol-name symbol)) + (push (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group) + collection)) + gnus-active-hashtb) + (list b e collection))))) (defun message-expand-name () - (cond ((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)))) + (pcase-let ((`(,b . ,e) (message-header-completion-bounds))) + (when message-expand-name-tables + (list b e (apply #'completion-table-in-turn + message-expand-name-tables))))) ;;; Help stuff. --=-=-=--