1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
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
|