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
| | ;;; 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:
;; No setup is required, since there is an entry for this backend
;; in `eudc-server-hotlist' by default.
;;
;; For example, if your `mail-personal-alias-file' (typically
;; ~/.mailrc) contains:
;;
;; alias lars "Lars <larsi@mail-abbrev.com>"
;;
;; Then:
;;
;; C-x m lars C-u M-x eudc-expand-try-all RET
;;
;; will expand the correct email address into the To: field of the
;; new message.
;;; 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)
;;;###autoload
(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))
(eudc-register-protocol 'mailabbrev)
(provide 'eudcb-mailabbrev)
;;; eudcb-mailabbrev.el ends here
|