unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] new EUDC backends for ecomplete, and mailabbrev (with ERT tests)
@ 2022-08-17  0:11 Alexander Adolf
  2022-08-17  1:47 ` Stefan Monnier
                   ` (2 more replies)
  0 siblings, 3 replies; 7+ messages in thread
From: Alexander Adolf @ 2022-08-17  0:11 UTC (permalink / raw)
  To: emacs-devel; +Cc: Thomas Fitzsimmons

[-- Attachment #1: Type: text/plain, Size: 3123 bytes --]

Hello,

as I had announced in the "message.el email address completion
refactoring" thread, attached below are two patches, adding a new EUDC
backend each; the first patch for ecomplete, and the second for
mailabbrev.

The ecomplete backend uses ecomplete's types as attributes. Quoting from
lisp/ecomplete.el:

---------------------------- Begin Quote -----------------------------
;; ecomplete stores matches in a file that looks like this:
;;
;; ((mail
;;  ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@gnus.org>")
;;  ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@red-bean.com>")
;;  ...
;;  ))
----------------------------- End Quote ------------------------------

This example shows a type of "mail". Users are free to use whatever
ecomplete types they wish. EUDC will look up in those types for which a
mapping to EUDC attribute names exists in the variable
`eudc-ecomplete-attributes-translation-alist`. The ecomplete search
function implements a substring match on the last element of each entry.


The mailabbrev backend looks at name, firstname, and email attributes in
the query only (this is hardcoded), since mailabbrev does not support
attributes at all. mailabbrev parses the user's .mailrc file (as is used
by /usr/bin/mail and /usr/bin/mailx) for 'alias' and 'source' entries.
Quoting from lisp/mail/mailabbrev.el:

---------------------------- Begin Quote -----------------------------
;;     alias someone "John Doe <doe@quux.com>"
[...]
;; Aliases in the mailrc file may be nested.  If you define aliases like
;;     alias group1 fred ethel
;;     alias group2 larry curly moe
;;     alias everybody group1 group2
;; Then when you type "everybody" on the To: line, it will be expanded to
;;     fred, ethyl, larry, curly, moe
[...]
;; This code also understands the "source" .mailrc command, for reading
;; aliases from some other file as well.
----------------------------- End Quote ------------------------------

The mailabbrev search function does exact matching on the alias names
only.

When a mailrc alias defines a distribution list, the EUDC result will
contain a single match, whose email attribute (the one and only
attribute in this case) contains a comma-separated list of RFC 5322
formatted email recipients on the list. This may not seem ideal when
using the EUDC query form, but was the only way of getting mailabbrev
distribution lists working with the function `eudc-expand-inline`. If
several, individual results were returned for a distribution list, they
would show nicely in the results view of the EUDC query form, but when
calling `eudc-expand-inline` for a distribution list, the recipients of
the list are shown as individual matches, and the user is prompted to
select one of them. Kind of "defeats the purpose" of a distribution
list. I thus decided to give precedence to `eudc-expand-inline`, and
return distribution list aliases as comma-separated lists.


I have also added ERT tests for both backends, and some email address
formatting code in EUDC core, which I had contributed earlier.


Looking forward to your thoughts,

  --alexander




[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-EUDC-backend-for-ecomplete.patch --]
[-- Type: text/x-patch, Size: 15856 bytes --]

From 86acef4db914af1ed23f11d118d5e6f56c8737dc Mon Sep 17 00:00:00 2001
From: Alexander Adolf <alexander.adolf@condition-alpha.com>
Date: Mon, 15 Aug 2022 22:40:46 +0200
Subject: [PATCH 1/2] New EUDC backend for ecomplete

* lisp/net/eudcb-ecomplete.el: new file implementing the new back-end
* doc/misc/eudc.texi: add text to describe the new backend, and how to
activate it
* etc/NEWS (EUDC): new item announcing the new backend
* test/lisp/net/eudc-tests.el: new file with ERT tests for RFC5322
email address formatting in EUDC core, and for querying the new
ecomplete backend
* test/lisp/net/eudc-resources/ecompleterc: sample ecompleterc
database file
---
 doc/misc/eudc.texi                       |  57 +++++++++
 etc/NEWS                                 |   6 +
 lisp/net/eudcb-ecomplete.el              | 113 ++++++++++++++++++
 test/lisp/net/eudc-resources/ecompleterc |   7 ++
 test/lisp/net/eudc-tests.el              | 141 +++++++++++++++++++++++
 5 files changed, 324 insertions(+)
 create mode 100644 lisp/net/eudcb-ecomplete.el
 create mode 100644 test/lisp/net/eudc-resources/ecompleterc
 create mode 100644 test/lisp/net/eudc-tests.el

diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 0037ba78d3..a09eb6801f 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -85,6 +85,8 @@ Overview
 BBDB, Big Brother's Insidious Database
 @item
 macOS Contacts
+@item
+@code{ecomplete}, Emacs's electrical completion
 @end itemize
 
 The main features of the EUDC interface are:
@@ -110,6 +112,7 @@ Overview
 * LDAP::                        What is LDAP ?
 * BBDB::                        What is BBDB ?
 * macOS Contacts::              What is macOS Contacts ?
+* ecomplete::                   What is @code{ecomplete} ?
 @end menu
 
 
@@ -173,6 +176,40 @@ macOS Contacts
 older versions.
 
 
+@node ecomplete
+@section @code{ecomplete}
+
+@code{ecomplete} is Emacs's ``electric completion'', and it is part of
+Emacs.  It stores all information in an @file{ecompleterc} file, whose
+location, and name can be configured via the variable
+@code{ecomplete-database-file} (which see).  The format of the file
+is:
+
+@display
+((TYPE_1 ITEM_1 ITEM_2 ...)
+ (TYPE_2 ITEM_N+1 ITEM_N+2 ...)
+ ...)
+@end display
+
+That is, it is an alist map where the key is the type of match (so
+that you can have one list of things for ``mail'', and one for, say,
+``mastodon'').  In each of these sections you then have a list where
+each item is of the form:
+
+@display
+(KEY TIMES-USED LAST-TIME-USED STRING)
+@end display
+
+When performing a query, the result will be all items where the search
+term matches all, or part of STRING.
+
+When EUDC performs queries with @code{ecomplete}, the name of each
+attribute making up the query is used as the type in which the lookup
+is performed.  The mapping from EUDC attribute names to
+@code{ecomplete} type names is performed according to the variable
+@code{eudc-ecomplete-attributes-translation-alist} (which see).
+
+
 @node Installation
 @chapter Installation
 
@@ -200,6 +237,7 @@ Installation
 @menu
 * LDAP Configuration::           EUDC needs external support for LDAP
 * macOS Contacts Configuration:: Enable the macOS Contacts backend
+* ecomplete Configuration::      Enable the ecomplete backend
 @end menu
 
 @node LDAP Configuration
@@ -433,6 +471,25 @@ macOS Contacts Configuration
 existing configurations, and may be removed in a future release.
 
 
+@node ecomplete Configuration
+@section @code{ecomplete} Configuration
+
+`ecomplete' is Emacs's ``electrical completion'', and is part of
+Emacs.  To use it, you will need to set up a database file
+(@pxref{ecomplete}) first.
+
+To enable the ecomplete backend, first `require' the respective
+library to load it, and then set the `eudc-server' to localhost in
+your init file:
+@lisp
+(require 'eudcb-ecomplete)
+(eudc-ecomplete-set-server "localhost")
+@end lisp
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
 @node Usage
 @chapter Usage
 
diff --git a/etc/NEWS b/etc/NEWS
index 5d87bc9e2e..a9bfb5030c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1636,6 +1636,12 @@ The EUDC back-end for the macOS Contacts app now provides a wider set
 of attributes to use for queries, and delivers more attributes in
 query results.
 
++++
+*** New back-end for ecomplete
+A new back-end for ecomplete allows information from that database to
+be queried by EUDC, too.  The attributes present in the EUDC query are
+used to select the entry type in the ecomplete database.
+
 ** EWW/SHR
 
 +++
diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el
new file mode 100644
index 0000000000..448dc61923
--- /dev/null
+++ b/lisp/net/eudcb-ecomplete.el
@@ -0,0 +1,113 @@
+;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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.
+;;
+;; GNU Emacs 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 GNU Emacs.  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/test/lisp/net/eudc-resources/ecompleterc b/test/lisp/net/eudc-resources/ecompleterc
new file mode 100644
index 0000000000..9019b26c9f
--- /dev/null
+++ b/test/lisp/net/eudc-resources/ecompleterc
@@ -0,0 +1,7 @@
+((mail
+ ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@ecomplete.org>")
+ ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@ecomplete.com>")
+ ("behse@ecomplete.org" 10 1516065455 "behse@ecomplete.org"))
+ (phone
+ ("Lars Ingebrigtsen" 0 0 "+1 234 5678 9012")
+ ("Karl Fogel" 0 0 "+33 701 4567 8901")))
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
new file mode 100644
index 0000000000..a3d886a2e0
--- /dev/null
+++ b/test/lisp/net/eudc-tests.el
@@ -0,0 +1,141 @@
+;;; eudc-tests.el --- Tests for EUDC -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Alexander Adolf <alexander.adolf@condition-alpha.com>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains tests for EUDC.
+
+;;; Code:
+
+(require 'ert)
+(require 'eudc)
+
+;;;;;;
+;;
+;;      Phase 0: pure core tests (no back-ends involved)
+;;
+
+;; eudc-rfc5322-quote-phrase (string)
+(ert-deftest eudc-test-rfc5322-quote-phrase ()
+  "Tests for RFC5322 compliant phrase quoting."
+  ;; atext-token "[:alpha:][:digit:]!#$%&'*+/=?^_`{|}~-"
+  (should (equal (eudc-rfc5322-quote-phrase "Foo Bar !#$%&'*+/=?^_`{|}~-")
+                 "Foo Bar !#$%&'*+/=?^_`{|}~-"))
+  (should (equal (eudc-rfc5322-quote-phrase "Foo, Bar !#$%&'*+/=?^_`{|}~-")
+                 "\"Foo, Bar !#$%&'*+/=?^_`{|}~-\"")))
+
+;; eudc-rfc5322-valid-comment-p (string)
+(ert-deftest eudc-test-rfc5322-valid-comment-p ()
+  "Tests for RFC5322 compliant comments."
+  ;; cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027" + fwsp-token (TAB, LF, SPC)
+  ;; Printable US-ASCII characters not including "(", ")", or "\".
+  (let ((good-chars (append (number-sequence #x09 #x0a)
+                            (number-sequence #x20 #x20)
+                            (number-sequence #x21 #x27)
+                            (number-sequence #x2a #x5b)
+                            (number-sequence #x5d #x7e)))
+        (bad-chars  (append (number-sequence #x00 #x08)
+                            (number-sequence #x0b #x1f)
+                            (number-sequence #x28 #x29)
+                            (number-sequence #x5c #x5c)
+                            (number-sequence #x7f #xff))))
+    (dolist (gc good-chars)
+      (should (eq (eudc-rfc5322-valid-comment-p (format "%c" gc)) t)))
+    (dolist (bc bad-chars)
+      (should (eq (eudc-rfc5322-valid-comment-p (format "%c" bc)) nil)))))
+
+;; eudc-rfc5322-make-address (address &optional firstname name comment)
+(ert-deftest eudc-test-make-address ()
+  "Tests for RFC5322 compliant email address formatting."
+  (should (equal (eudc-rfc5322-make-address "")
+                 nil))
+  (should (equal (eudc-rfc5322-make-address nil)
+                 nil))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org")
+                 "j.sixpack@example.org"))
+  (should (equal (eudc-rfc5322-make-address "<j.sixpack@example.org>")
+                 "<j.sixpack@example.org>"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            "Joey")
+                 "Joey <j.sixpack@example.org>"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            "Joey"
+                                            "Sixpack")
+                 "Joey Sixpack <j.sixpack@example.org>"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            "Joey"
+                                            "Sixpack"
+                                            "ten-packs are fine, too")
+                 "Joey Sixpack <j.sixpack@example.org> (ten-packs are fine, too)"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            ""
+                                            "Sixpack, Joey")
+                 "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            nil
+                                            "Sixpack, Joey")
+                 "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            nil
+                                            nil
+                                            "Duh!")
+                 "j.sixpack@example.org (Duh!)"))
+  (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+                                            nil
+                                            nil
+                                            "Duh\\!")
+                 "j.sixpack@example.org")))
+
+;;;;;;
+;;
+;;      Phase 1: back-end tests
+;;
+
+(require 'ert-x)
+
+;;;;;;
+;;      Phase 1.0: ecomplete back-end
+;;
+
+(require 'eudcb-ecomplete)
+
+(ert-deftest eudcb-ecomplete ()
+  "Test the ecomplete back-end."
+  (ert-with-temp-directory home
+    (with-environment-variables (("HOME" home))
+      (let ((ecomplete-database-file (ert-resource-file "ecompleterc"))
+            (eudc-options-file (locate-user-emacs-file "eudc-options" ".eudc-options")))
+        (eudc-ecomplete-set-server "localhost")
+        (should (equal (eudc-ecomplete-query-internal '((mail . "brigts")))
+                       '(((mail . "larsi@ecomplete.org")
+                          (name . "Lars Ingebrigtsen")))))
+        (should (equal (eudc-ecomplete-query-internal '((mail . "karl")))
+                       '(((mail . "kfogel@ecomplete.com")
+                          (name . "Karl Fogel")))))
+        (should (equal (eudc-ecomplete-query-internal '((mail . "behs")))
+                       '(((mail . "behse@ecomplete.org")))))
+        (should (equal (eudc-ecomplete-query-internal '((mail . "louie")))
+                       nil))))))
+
+
+(provide 'eudc-tests)
+;;; eudc-tests.el ends here
-- 
2.37.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-New-EUDC-backend-for-mailabbrev.patch --]
[-- Type: text/x-patch, Size: 12646 bytes --]

From f9466b1e3ef2a091e926fa82b9d1fea95a93e553 Mon Sep 17 00:00:00 2001
From: Alexander Adolf <alexander.adolf@condition-alpha.com>
Date: Wed, 17 Aug 2022 01:23:38 +0200
Subject: [PATCH 2/2] New EUDC backend for mailabbrev

* lisp/net/eudcb-mailabbrev.el: new file implementing the new back-end
* doc/misc/eudc.texi: add text to describe the new backend, and how to
activate it
* etc/NEWS (EUDC): new item announcing the new backend
* test/lisp/net/eudc-tests.el: add tests for querying the new
ecomplete backend
* test/lisp/net/eudc-resources/mailrc: sample mailabbrev
database file used for tests
---
 doc/misc/eudc.texi                  |  52 +++++++++++
 etc/NEWS                            |   6 ++
 lisp/net/eudcb-mailabbrev.el        | 133 ++++++++++++++++++++++++++++
 test/lisp/net/eudc-resources/mailrc |   3 +
 test/lisp/net/eudc-tests.el         |  30 +++++++
 5 files changed, 224 insertions(+)
 create mode 100644 lisp/net/eudcb-mailabbrev.el
 create mode 100644 test/lisp/net/eudc-resources/mailrc

diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index a09eb6801f..955ab345be 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -87,6 +87,8 @@ Overview
 macOS Contacts
 @item
 @code{ecomplete}, Emacs's electrical completion
+@item
+@code{mailabbrev}, Emacs's abbrev-expansion of mail aliases
 @end itemize
 
 The main features of the EUDC interface are:
@@ -113,6 +115,7 @@ Overview
 * BBDB::                        What is BBDB ?
 * macOS Contacts::              What is macOS Contacts ?
 * ecomplete::                   What is @code{ecomplete} ?
+* mailabbrev::                  What is @code{mailabbrev}?
 @end menu
 
 
@@ -210,6 +213,35 @@ ecomplete
 @code{eudc-ecomplete-attributes-translation-alist} (which see).
 
 
+@node mailabbrev
+@section @code{mailabbrev}
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs.  It stores all information in a @file{mailrc}
+file, whose location, and name can be configured via the variable
+@code{mail-personal-alias-file} (which see).  The @file{mailrc} file
+has the same format as the @command{mail} and @command{mailx} commands
+use for their startup configuration file.  @code{mailabbrev} processes
+@samp{alias}, and @samp{source} statements in the @file{mailrc} file.
+@samp{alias} statements can define simple aliases and distribution
+lists, and and can be nested in that the alias expansion can contain
+references to other alias definitions.  Forward references, that is
+references to aliases before they are actually defined, are possible,
+too.
+
+Originally, @code{mailabbrev} was designed to be used with
+@code{abbrev-mode}.  The @code{mailabbrev} EUDC backend does not use
+@code{abbrev-mode}, but queries @code{mailabbrev} for alias entries
+only, and returns these as EUDC results.  All entries where the alias
+name exactly equals either the @code{email}, @code{name}, or
+@code{firstname} attribute value in the EUDC query, will be returned
+as matches.  When a @file{mailrc} alias defines a distribution list,
+that is it expands to more than one email address, the EUDC result
+will contain a single entry, which will contain an email attribute
+only, whose value will be a comma-separated list of RFC 5322 formatted
+recipient specifications.
+
+
 @node Installation
 @chapter Installation
 
@@ -238,6 +270,7 @@ Installation
 * LDAP Configuration::           EUDC needs external support for LDAP
 * macOS Contacts Configuration:: Enable the macOS Contacts backend
 * ecomplete Configuration::      Enable the ecomplete backend
+* mailabbrev Configuration::     Enable the mailabbrev backend
 @end menu
 
 @node LDAP Configuration
@@ -490,6 +523,25 @@ ecomplete Configuration
 @pxref{Multi-server Queries}.
 
 
+@node mailabbrev Configuration
+@section @code{mailabbrev} Configuration
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs.  To use it, you will need to set up a database file
+(@pxref{mailabbrev}) first.
+
+To enable the mailabbrev backend, first `require' the respective
+library to load it, and then set the `eudc-server' to localhost in
+your init file:
+@lisp
+(require 'eudcb-mailabbrev)
+(eudc-mailabbrev-set-server "localhost")
+@end lisp
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
 @node Usage
 @chapter Usage
 
diff --git a/etc/NEWS b/etc/NEWS
index a9bfb5030c..2c6e10c618 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1642,6 +1642,12 @@ A new back-end for ecomplete allows information from that database to
 be queried by EUDC, too.  The attributes present in the EUDC query are
 used to select the entry type in the ecomplete database.
 
++++
+*** New back-end for mailabbrev
+A new back-end for mailabbrev allows information from that database to
+be queried by EUDC, too.  The attributes email, name, and firstname
+are supported only.
+
 ** EWW/SHR
 
 +++
diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el
new file mode 100644
index 0000000000..8911661afd
--- /dev/null
+++ b/lisp/net/eudcb-mailabbrev.el
@@ -0,0 +1,133 @@
+;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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.
+;;
+;; GNU Emacs 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 GNU Emacs.  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, only the email,
+name, and firstname attributes in the QUERY are considered, and
+their values are matched against the alias names in the mailrc
+file.  When a mailrc alias is a distribution list, that is it
+expands to more that one email address, the individual recipient
+specifications are formatted using `eudc-rfc5322-make-address',
+and returned as a comma-separated list in the email address
+attribute.
+
+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))
+             (raw-matches (symbol-value (intern-soft value mail-abbrevs))))
+        (when (and raw-matches
+                   (memq attr '(email firstname name)))
+          (let* ((matches (split-string raw-matches ", "))
+                 (num-matches (length matches)))
+            (if (> num-matches 1)
+                ;; multiple matches: distribution list
+                (let ((distr-str (string)))
+                  (dolist (recipient matches)
+                    ;; try to decompose email construct
+                    (let* ((decoded (mail-header-parse-address recipient t))
+                           (name (cdr decoded))
+                           (email (car decoded)))
+                      (if decoded
+                          ;; decoding worked, push rfc5322 rendered address
+                          (setq distr-str
+                                (copy-sequence
+                                 (concat distr-str ", "
+                                         (eudc-rfc5322-make-address email
+                                                                    nil
+                                                                    name))))
+                        ;; else, just forward the value as-is
+                        (setq distr-str
+                              (copy-sequence
+                               (concat distr-str ", " recipient))))))
+                  ;; push result, removing the leading ", "
+                  (push (list (cons 'email (substring distr-str 2 -1)))
+                        result))
+              ;; simple case: single match
+              (let* ((match (car matches))
+                     (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
diff --git a/test/lisp/net/eudc-resources/mailrc b/test/lisp/net/eudc-resources/mailrc
new file mode 100644
index 0000000000..c565f71837
--- /dev/null
+++ b/test/lisp/net/eudc-resources/mailrc
@@ -0,0 +1,3 @@
+alias lars "Lars Ingebrigtsen <larsi@mail-abbrev.com>"
+alias karl "Karl Fogel <kfogel@mail-abbrev.com>"
+alias emacsheroes lars karl
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
index a3d886a2e0..8189d89187 100644
--- a/test/lisp/net/eudc-tests.el
+++ b/test/lisp/net/eudc-tests.el
@@ -136,6 +136,36 @@ eudcb-ecomplete
         (should (equal (eudc-ecomplete-query-internal '((mail . "louie")))
                        nil))))))
 
+;;;;;;
+;;
+;;      Phase 1.1: mailabbrev back-end
+;;
+
+(require 'eudcb-mailabbrev)
+
+(ert-deftest eudcb-mailabbrev ()
+  "Test the mailabbrev back-end."
+  (ert-with-temp-directory home
+    (with-environment-variables (("HOME" home))
+      (let ((mail-personal-alias-file (ert-resource-file "mailrc"))
+            (eudc-options-file (locate-user-emacs-file "eudc-options" ".eudc-options")))
+        (eudc-mailabbrev-set-server "localhost")
+        (should (equal (eudc-mailabbrev-query-internal '((email . "lars")))
+                       '(((email . "larsi@mail-abbrev.com")
+                          (name . "Lars Ingebrigtsen")))))
+        (should (equal (eudc-mailabbrev-query-internal '((name . "lars")))
+                       '(((email . "larsi@mail-abbrev.com")
+                          (name . "Lars Ingebrigtsen")))))
+        (should (equal (eudc-mailabbrev-query-internal '((phone . "lars")))
+                       nil))
+        (should (equal (eudc-mailabbrev-query-internal '((firstname . "karl")))
+                       '(((email . "kfogel@mail-abbrev.com")
+                          (name . "Karl Fogel")))))
+        (should (equal (eudc-mailabbrev-query-internal '((email . "louie")))
+                       nil))
+        (should (equal (eudc-mailabbrev-query-internal '((name . "emacsheroes")))
+                       '(((email . "Lars Ingebrigtsen <larsi@mail-abbrev.com>, Karl Fogel <kfogel@mail-abbrev.com")))))))))
+
 
 (provide 'eudc-tests)
 ;;; eudc-tests.el ends here
-- 
2.37.1


^ permalink raw reply related	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2022-11-29  0:46 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-08-17  0:11 [PATCH] new EUDC backends for ecomplete, and mailabbrev (with ERT tests) Alexander Adolf
2022-08-17  1:47 ` Stefan Monnier
2022-11-09  2:27   ` Thomas Fitzsimmons
2022-08-18 13:14 ` Thomas Fitzsimmons
2022-10-15 14:32 ` Thomas Fitzsimmons
2022-11-28 21:28   ` Alexander Adolf
2022-11-29  0:46     ` Thomas Fitzsimmons

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).