From: Alexander Adolf <alexander.adolf@condition-alpha.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: Thoughts on Refactoring In-Buffer Completion In message.el
Date: Wed, 27 Jul 2022 23:16:48 +0200 [thread overview]
Message-ID: <cb72b5317bff7345cd468863f4d2d139@condition-alpha.com> (raw)
In-Reply-To: <jwvk087jq3p.fsf-monnier+emacs@gnu.org>
[-- 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
next prev parent reply other threads:[~2022-07-27 21:16 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=cb72b5317bff7345cd468863f4d2d139@condition-alpha.com \
--to=alexander.adolf@condition-alpha.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).