From f9466b1e3ef2a091e926fa82b9d1fea95a93e553 Mon Sep 17 00:00:00 2001 From: Alexander Adolf 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 . + +;;; 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 " +alias karl "Karl Fogel " +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 , Karl Fogel