From 86acef4db914af1ed23f11d118d5e6f56c8737dc Mon Sep 17 00:00:00 2001 From: Alexander Adolf 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 . + +;;; 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 ") + ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel ") + ("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 +;; Maintainer: Thomas Fitzsimmons + +;; 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 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 "") + "")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey") + "Joey ")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey" + "Sixpack") + "Joey Sixpack ")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey" + "Sixpack" + "ten-packs are fine, too") + "Joey Sixpack (ten-packs are fine, too)")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "" + "Sixpack, Joey") + "\"Sixpack, Joey\" ")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + nil + "Sixpack, Joey") + "\"Sixpack, Joey\" ")) + (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