Commit | Line | Data |
---|---|---|
daca8ba5 | 1 | ;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*- |
6594deb0 | 2 | |
ab422c4d PE |
3 | ;; Copyright (C) 1985, 1987, 1995-1997, 2001-2013 Free Software |
4 | ;; Foundation, Inc. | |
3a801d0c | 5 | |
e5167999 | 6 | ;; Maintainer: FSF |
fd7fa35a | 7 | ;; Keywords: mail |
e5167999 | 8 | |
80a677d9 JA |
9 | ;; This file is part of GNU Emacs. |
10 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
80a677d9 | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
80a677d9 JA |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
80a677d9 | 23 | |
e41b2db1 ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; Basic functions for defining and expanding mail aliases. | |
27 | ;; These seal off the interface to the alias-definition parts of a | |
28 | ;; .mailrc file formatted for BSD's Mail or USL's mailx. | |
29 | ||
e5167999 | 30 | ;;; Code: |
80a677d9 | 31 | |
594906dd | 32 | (require 'sendmail) |
c2db7f31 | 33 | |
31407d5d | 34 | (defgroup mailalias nil |
f5684faf | 35 | "Expanding mail aliases." |
31407d5d | 36 | :group 'mail) |
48919e0f | 37 | |
31407d5d | 38 | (defcustom mail-passwd-files '("/etc/passwd") |
c1051e81 | 39 | "List of files from which to determine valid user names." |
31407d5d RS |
40 | :type '(repeat string) |
41 | :group 'mailalias) | |
8e3beae0 | 42 | |
31407d5d | 43 | (defcustom mail-passwd-command nil |
c1051e81 | 44 | "Shell command to retrieve text to add to `/etc/passwd', or nil." |
31407d5d RS |
45 | :type '(choice string (const nil)) |
46 | :group 'mailalias) | |
8e3beae0 | 47 | |
48919e0f RS |
48 | (defvar mail-directory-names t |
49 | "Alist of mail address directory entries. | |
50 | When t this still needs to be initialized.") | |
51 | ||
52 | (defvar mail-address-field-regexp | |
53 | "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):") | |
54 | ||
daca8ba5 SM |
55 | (defvar pattern) |
56 | ||
31407d5d | 57 | (defcustom mail-complete-alist |
310d0d40 RS |
58 | ;; Don't refer to mail-address-field-regexp here; |
59 | ;; that confuses some things such as cus-dep.el. | |
daca8ba5 SM |
60 | '(("^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" |
61 | . (mail-get-names pattern)) | |
62 | ("Newsgroups:" . (if (boundp 'gnus-active-hashtb) | |
63 | gnus-active-hashtb | |
64 | (if (boundp news-group-article-assoc) | |
65 | news-group-article-assoc))) | |
66 | ("Followup-To:" . (mail-sentto-newsgroups)) | |
67 | ;;("Distribution:" ???) | |
68 | ) | |
c1051e81 | 69 | "Alist of header field and expression to return alist for completion. |
31407d5d RS |
70 | The expression may reference the variable `pattern' |
71 | which will hold the string being completed. | |
72 | If not on matching header, `mail-complete-function' gets called instead." | |
bd09e573 | 73 | :type 'alist |
31407d5d RS |
74 | :group 'mailalias) |
75 | (put 'mail-complete-alist 'risky-local-variable t) | |
48919e0f | 76 | |
e694581d | 77 | ;;;###autoload |
31407d5d | 78 | (defcustom mail-complete-style 'angles |
c1051e81 | 79 | "Specifies how \\[mail-complete] formats the full name when it completes. |
e694581d RS |
80 | If `nil', they contain just the return address like: |
81 | king@grassland.com | |
82 | If `parens', they look like: | |
83 | king@grassland.com (Elvis Parsley) | |
84 | If `angles', they look like: | |
31407d5d RS |
85 | Elvis Parsley <king@grassland.com>" |
86 | :type '(choice (const angles) (const parens) (const nil)) | |
87 | :group 'mailalias) | |
48919e0f | 88 | |
31407d5d | 89 | (defcustom mail-complete-function 'ispell-complete-word |
c1051e81 | 90 | "Function to call when completing outside `mail-complete-alist'-header." |
31407d5d RS |
91 | :type '(choice function (const nil)) |
92 | :group 'mailalias) | |
daca8ba5 SM |
93 | (make-obsolete-variable 'mail-complete-function |
94 | 'completion-at-point-functions "24.1") | |
48919e0f | 95 | |
31407d5d | 96 | (defcustom mail-directory-function nil |
c1051e81 | 97 | "Function to get completions from directory service or nil for none. |
31407d5d RS |
98 | See `mail-directory-requery'." |
99 | :type '(choice function (const nil)) | |
100 | :group 'mailalias) | |
48919e0f RS |
101 | |
102 | ;; This is for when the directory is huge, or changes frequently. | |
31407d5d | 103 | (defcustom mail-directory-requery nil |
c1051e81 | 104 | "When non-nil call `mail-directory-function' for each completion. |
48919e0f | 105 | In that case, one argument gets passed to the function, the partial string |
31407d5d RS |
106 | entered so far." |
107 | :type 'boolean | |
108 | :group 'mailalias) | |
48919e0f | 109 | |
31407d5d | 110 | (defcustom mail-directory-process nil |
c1051e81 | 111 | "Shell command to get the list of names from a mail directory. |
31407d5d RS |
112 | This value is used when the value of `mail-directory-function' |
113 | is `mail-directory-process'. The value should be a list | |
114 | of the form (COMMAND ARG ...), where each of the list elements | |
f6250436 RS |
115 | is evaluated. COMMAND should evaluate to a string. When |
116 | `mail-directory-requery' is non-nil, during evaluation of these | |
117 | elements, the variable `pattern' contains the partial input being | |
118 | completed. `pattern' is nil when `mail-directory-requery' is nil. | |
48919e0f | 119 | |
31407d5d | 120 | The value might look like this: |
48919e0f RS |
121 | |
122 | '(remote-shell-program \"HOST\" \"-nl\" \"USER\" \"COMMAND\") | |
123 | ||
31407d5d | 124 | or like this: |
48919e0f | 125 | |
31407d5d RS |
126 | '(remote-shell-program \"HOST\" \"-n\" \"COMMAND '^\" pattern \"'\")" |
127 | :type 'sexp | |
128 | :group 'mailalias) | |
129 | (put 'mail-directory-process 'risky-local-variable t) | |
48919e0f | 130 | |
31407d5d | 131 | (defcustom mail-directory-stream nil |
c1051e81 | 132 | "List of (HOST SERVICE) for stream connection to mail directory." |
31407d5d RS |
133 | :type 'sexp |
134 | :group 'mailalias) | |
135 | (put 'mail-directory-stream 'risky-local-variable t) | |
48919e0f | 136 | |
31407d5d | 137 | (defcustom mail-directory-parser nil |
c1051e81 | 138 | "How to interpret the output of `mail-directory-function'. |
48919e0f RS |
139 | Three types of values are possible: |
140 | ||
141 | - nil means to gather each line as one name | |
142 | - regexp means first \\(grouping\\) in successive matches is name | |
31407d5d | 143 | - function called at beginning of buffer that returns an alist of names" |
94955307 | 144 | :type '(choice (const nil) regexp function) |
31407d5d RS |
145 | :group 'mailalias) |
146 | (put 'mail-directory-parser 'risky-local-variable t) | |
48919e0f | 147 | |
31407d5d RS |
148 | ;; Internal variables. |
149 | ||
150 | (defvar mail-names t | |
151 | "Alist of local users, aliases and directory entries as available. | |
152 | Elements have the form (MAILNAME) or (MAILNAME . FULLNAME). | |
153 | If the value means t, it means the real value should be calculated | |
f6250436 | 154 | for the next use. This is used in `mail-complete'.") |
31407d5d RS |
155 | |
156 | (defvar mail-local-names t | |
157 | "Alist of local users. | |
158 | When t this still needs to be initialized.") | |
159 | \f | |
48919e0f | 160 | |
80a677d9 JA |
161 | ;; Called from sendmail-send-it, or similar functions, |
162 | ;; only if some mail aliases are defined. | |
e28449ed | 163 | ;;;###autoload |
80a677d9 JA |
164 | (defun expand-mail-aliases (beg end &optional exclude) |
165 | "Expand all mail aliases in suitable header fields found between BEG and END. | |
30eaaa34 | 166 | If interactive, expand in header fields. |
1abe8488 KH |
167 | Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and |
168 | their `Resent-' variants. | |
169 | ||
96846422 RS |
170 | Optional second arg EXCLUDE may be a regular expression defining text to be |
171 | removed from alias expansions." | |
e28449ed SM |
172 | (interactive |
173 | (save-excursion | |
174 | (list (goto-char (point-min)) | |
30eaaa34 | 175 | (mail-header-end)))) |
e934d700 | 176 | (sendmail-sync-aliases) |
e28449ed SM |
177 | (when (eq mail-aliases t) |
178 | (setq mail-aliases nil) | |
179 | (build-mail-aliases)) | |
180 | (save-excursion | |
181 | (goto-char beg) | |
182 | (setq end (set-marker (make-marker) end)) | |
183 | (let ((case-fold-search nil)) | |
184 | (while (let ((case-fold-search t)) | |
185 | (re-search-forward mail-address-field-regexp end t)) | |
186 | (skip-chars-forward " \t") | |
187 | (let ((beg1 (point)) | |
188 | end1 pos epos seplen | |
189 | ;; DISABLED-ALIASES records aliases temporarily disabled | |
190 | ;; while we scan text that resulted from expanding those aliases. | |
191 | ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN | |
192 | ;; is where to reenable the alias (expressed as number of chars | |
193 | ;; counting from END1). | |
194 | (disabled-aliases nil)) | |
195 | (re-search-forward "^[^ \t]" end 'move) | |
196 | (beginning-of-line) | |
197 | (skip-chars-backward " \t\n") | |
198 | (setq end1 (point-marker)) | |
199 | (goto-char beg1) | |
200 | (while (< (point) end1) | |
201 | (setq pos (point)) | |
202 | ;; Reenable any aliases which were disabled for ranges | |
203 | ;; that we have passed out of. | |
204 | (while (and disabled-aliases | |
205 | (> pos (- end1 (cdr (car disabled-aliases))))) | |
206 | (setq disabled-aliases (cdr disabled-aliases))) | |
207 | ;; EPOS gets position of end of next name; | |
208 | ;; SEPLEN gets length of whitespace&separator that follows it. | |
209 | (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t) | |
210 | (setq epos (match-beginning 0) | |
211 | seplen (- (point) epos)) | |
212 | (setq epos (marker-position end1) seplen 0)) | |
213 | (let ((string (buffer-substring-no-properties pos epos)) | |
214 | translation) | |
215 | (if (and (not (assoc string disabled-aliases)) | |
216 | (setq translation (cdr (assoc string mail-aliases)))) | |
217 | (progn | |
218 | ;; This name is an alias. Disable it. | |
219 | (setq disabled-aliases (cons (cons string (- end1 epos)) | |
220 | disabled-aliases)) | |
221 | ;; Replace the alias with its expansion | |
222 | ;; then rescan the expansion for more aliases. | |
223 | (goto-char pos) | |
224 | (insert translation) | |
225 | (when exclude | |
226 | (let ((regexp (concat "\\b\\(" exclude "\\)\\b")) | |
80a677d9 JA |
227 | (end (point-marker))) |
228 | (goto-char pos) | |
229 | (while (re-search-forward regexp end t) | |
230 | (replace-match "")) | |
231 | (goto-char end))) | |
e28449ed SM |
232 | (delete-region (point) (+ (point) (- epos pos))) |
233 | (goto-char pos)) | |
234 | ;; Name is not an alias. Skip to start of next name. | |
235 | (goto-char epos) | |
236 | (forward-char seplen)))) | |
237 | (set-marker end1 nil))) | |
238 | (set-marker end nil)))) | |
80a677d9 | 239 | |
9d73ab0d NF |
240 | ;; Called by mail-setup, or similar functions, only if the file specified |
241 | ;; by mail-personal-alias-file (usually `~/.mailrc') exists. | |
80a677d9 | 242 | (defun build-mail-aliases (&optional file) |
9d73ab0d NF |
243 | "Read mail aliases from personal aliases file and set `mail-aliases'. |
244 | By default, this is the file specified by `mail-personal-alias-file'." | |
53aff12a GM |
245 | (interactive |
246 | (list | |
247 | (read-file-name (format "Read mail alias file (default %s): " | |
248 | mail-personal-alias-file) | |
249 | nil mail-personal-alias-file t))) | |
9d73ab0d | 250 | (setq file (expand-file-name (or file mail-personal-alias-file))) |
3c3d71d9 RS |
251 | ;; In case mail-aliases is t, make sure define-mail-alias |
252 | ;; does not recursively call build-mail-aliases. | |
253 | (setq mail-aliases nil) | |
9421bdd1 SM |
254 | (with-temp-buffer |
255 | (while file | |
256 | (cond ((get-file-buffer file) | |
257 | (insert (with-current-buffer (get-file-buffer file) | |
258 | (buffer-substring-no-properties | |
259 | (point-min) (point-max))))) | |
260 | ((file-exists-p file) (insert-file-contents file)) | |
261 | ((file-exists-p (setq file (expand-file-name file "~/"))) | |
262 | (insert-file-contents file)) | |
263 | (t (setq file nil))) | |
264 | (goto-char (point-min)) | |
265 | ;; Delete comments from the contents. | |
266 | (while (search-forward "# " nil t) | |
267 | (let ((p (- (point) 2))) | |
268 | (end-of-line) | |
269 | (delete-region p (point)))) | |
270 | ;; Don't lose if no final newline. | |
271 | (goto-char (point-max)) | |
272 | (or (eq (preceding-char) ?\n) (newline)) | |
273 | (goto-char (point-min)) | |
274 | ;; handle "\\\n" continuation lines | |
275 | (while (not (eobp)) | |
276 | (end-of-line) | |
277 | (if (= (preceding-char) ?\\) | |
278 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
279 | (forward-char 1))) | |
280 | (goto-char (point-min)) | |
281 | ;; handle `source' directives -- Eddy/1994/May/25 | |
282 | (cond ((re-search-forward "^source[ \t]+" nil t) | |
283 | (re-search-forward "\\S-+") | |
284 | (setq file (buffer-substring-no-properties | |
285 | (match-beginning 0) (match-end 0))) | |
286 | (beginning-of-line) | |
287 | (insert "# ") ; to ensure we don't re-process this file | |
288 | (beginning-of-line)) | |
289 | (t (setq file nil)))) | |
290 | (goto-char (point-min)) | |
291 | (while (re-search-forward | |
292 | "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t\n]+\\)" nil t) | |
293 | (let* ((name (match-string 2)) | |
294 | (start (progn (skip-chars-forward " \t") (point))) | |
295 | value) | |
296 | (end-of-line) | |
297 | (setq value (buffer-substring-no-properties start (point))) | |
298 | (unless (equal value "") | |
299 | (define-mail-alias name value t)))) | |
300 | mail-aliases)) | |
80a677d9 JA |
301 | |
302 | ;; Always autoloadable in case the user wants to define aliases | |
303 | ;; interactively or in .emacs. | |
c8ca9217 | 304 | ;; define-mail-abbrev in mailabbrev.el duplicates much of this code. |
7229064d | 305 | ;;;###autoload |
37e379dd | 306 | (defun define-mail-alias (name definition &optional from-mailrc-file) |
96846422 | 307 | "Define NAME as a mail alias that translates to DEFINITION. |
80a677d9 | 308 | This means that sending a message to NAME will actually send to DEFINITION. |
fa786521 RS |
309 | |
310 | Normally, the addresses in DEFINITION must be separated by commas. | |
a1506d29 | 311 | If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION |
fa786521 RS |
312 | can be separated by spaces; an address can contain spaces |
313 | if it is quoted with double-quotes." | |
314 | ||
80a677d9 JA |
315 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") |
316 | ;; Read the defaults first, if we have not done so. | |
3c3d71d9 RS |
317 | ;; But not if we are doing that already right now. |
318 | (unless from-mailrc-file | |
319 | (sendmail-sync-aliases)) | |
80a677d9 JA |
320 | (if (eq mail-aliases t) |
321 | (progn | |
322 | (setq mail-aliases nil) | |
9d73ab0d | 323 | (if (file-exists-p mail-personal-alias-file) |
80a677d9 | 324 | (build-mail-aliases)))) |
3af1a1f3 RS |
325 | ;; strip garbage from front and end |
326 | (if (string-match "\\`[ \t\n,]+" definition) | |
aa228418 | 327 | (setq definition (substring definition (match-end 0)))) |
3af1a1f3 | 328 | (if (string-match "[ \t\n,]+\\'" definition) |
aa228418 | 329 | (setq definition (substring definition 0 (match-beginning 0)))) |
c8ca9217 CY |
330 | |
331 | (let* ((L (length definition)) | |
332 | (start (if (> L 0) 0)) | |
333 | end this-entry result tem) | |
37e379dd | 334 | (while start |
c8ca9217 CY |
335 | (cond |
336 | (from-mailrc-file | |
337 | ;; If we're reading from the mailrc file, addresses are | |
338 | ;; delimited by spaces, and addresses with embedded spaces are | |
339 | ;; surrounded by non-escaped double-quotes. | |
340 | (if (eq ?\" (aref definition start)) | |
341 | (setq start (1+ start) | |
342 | end (and (string-match | |
343 | "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*" | |
344 | definition start) | |
345 | (match-end 1))) | |
346 | (setq end (string-match "[ \t,]+" definition start))) | |
347 | ;; Extract the address and advance the loop past it. | |
348 | (setq this-entry (substring definition start end) | |
349 | start (and end (/= (match-end 0) L) (match-end 0))) | |
350 | ;; If the full name contains a problem character, quote it. | |
351 | (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry) | |
352 | (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]" | |
353 | (match-string 1 this-entry)) | |
354 | (setq this-entry (replace-regexp-in-string | |
355 | "\\(.+?\\)[ \t]*\\(<.*>\\)" | |
356 | "\"\\1\" \\2" | |
357 | this-entry)))) | |
358 | ;; When we are not reading from .mailrc, addresses are | |
359 | ;; separated by commas. Try to accept a rfc822-like syntax. | |
360 | ;; (Todo: extend rfc822.el to do the work for us.) | |
361 | ((equal (string-match | |
362 | "[ \t,]*\\(\"\\(?:[^\"]\\|[^\\]\\(?:[\\][\\]\\)*\"\\)*\"[ \t]*\ | |
363 | <[-.!#$%&'*+/0-9=?A-Za-z^_`{|}~@]+>\\)[ \t,]*" | |
364 | definition start) | |
365 | start) | |
366 | ;; If an entry has a valid [ "foo bar" <foo@example.com> ] | |
367 | ;; form, use it literally . This also allows commas in the | |
368 | ;; quoted string, e.g. [ "foo bar, jr" <foo@example.com> ] | |
369 | (setq this-entry (match-string 1 definition) | |
370 | start (and (/= (match-end 0) L) (match-end 0)))) | |
371 | (t | |
372 | ;; Otherwise, read the next address by looking for a comma. | |
373 | (setq end (string-match "[ \t\n,]*,[ \t\n]*" definition start)) | |
374 | (setq this-entry (substring definition start end)) | |
375 | ;; Advance the loop past this address. | |
376 | (setq start (and end (/= (match-end 0) L) (match-end 0))) | |
377 | ;; If the full name contains a problem character, quote it. | |
378 | (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry) | |
379 | (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]" | |
380 | (match-string 1 this-entry)) | |
381 | (setq this-entry (replace-regexp-in-string | |
382 | "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2" | |
383 | this-entry))))) | |
384 | (push this-entry result)) | |
385 | ||
37e379dd | 386 | (setq definition (mapconcat (function identity) |
c8ca9217 | 387 | (nreverse result) ", ")) |
80a677d9 JA |
388 | (setq tem (assoc name mail-aliases)) |
389 | (if tem | |
390 | (rplacd tem definition) | |
48919e0f RS |
391 | (setq mail-aliases (cons (cons name definition) mail-aliases) |
392 | mail-names t)))) | |
393 | ||
c0fd4267 | 394 | ;;;###autoload |
daca8ba5 SM |
395 | (defun mail-completion-at-point-function () |
396 | "Compute completion data for mail aliases. | |
397 | For use on `completion-at-point-functions'." | |
9a03a6f4 SM |
398 | ;; Read the defaults first, if we have not done so. |
399 | (sendmail-sync-aliases) | |
400 | (if (eq mail-aliases t) | |
401 | (progn | |
402 | (setq mail-aliases nil) | |
403 | (if (file-exists-p mail-personal-alias-file) | |
404 | (build-mail-aliases)))) | |
daca8ba5 SM |
405 | (let ((list mail-complete-alist) |
406 | (list-exp nil)) | |
baaddce7 | 407 | (if (and (< 0 (mail-header-end)) |
48919e0f | 408 | (save-excursion |
daca8ba5 | 409 | (if (re-search-backward "^[^\t ]" nil t) |
48919e0f RS |
410 | (while list |
411 | (if (looking-at (car (car list))) | |
daca8ba5 | 412 | (setq list-exp (cdr (car list)) |
48919e0f RS |
413 | list ()) |
414 | (setq list (cdr list))))) | |
daca8ba5 | 415 | list-exp)) |
48919e0f RS |
416 | (let* ((end (point)) |
417 | (beg (save-excursion | |
418 | (skip-chars-backward "^ \t<,:") | |
419 | (point))) | |
daca8ba5 SM |
420 | (table (completion-table-dynamic |
421 | (lambda (prefix) | |
422 | (let ((pattern prefix)) (eval list-exp)))))) | |
423 | (list beg end table))))) | |
48919e0f | 424 | |
daca8ba5 SM |
425 | ;;;###autoload |
426 | (defun mail-complete (arg) | |
427 | "Perform completion on header field or word preceding point. | |
428 | Completable headers are according to `mail-complete-alist'. If none matches | |
429 | current header, calls `mail-complete-function' and passes prefix ARG if any." | |
59f7af81 | 430 | (declare (obsolete mail-completion-at-point-function "24.1")) |
daca8ba5 SM |
431 | (interactive "P") |
432 | ;; Read the defaults first, if we have not done so. | |
433 | (sendmail-sync-aliases) | |
434 | (if (eq mail-aliases t) | |
435 | (progn | |
436 | (setq mail-aliases nil) | |
437 | (if (file-exists-p mail-personal-alias-file) | |
438 | (build-mail-aliases)))) | |
439 | (let ((data (mail-completion-at-point-function))) | |
440 | (if data | |
441 | (apply #'completion-in-region data) | |
442 | (funcall mail-complete-function arg)))) | |
daca8ba5 SM |
443 | |
444 | (defun mail-completion-expand (table) | |
445 | "Build new completion table that expands aliases. | |
446 | Completes like TABLE except that if the completion is a valid alias, | |
447 | it expands it to its full `mail-complete-style' form." | |
448 | (lambda (string pred action) | |
449 | (cond | |
450 | ((eq action nil) | |
451 | (let* ((comp (try-completion string table pred)) | |
452 | (name (and (listp table) comp | |
453 | (assoc (if (stringp comp) comp string) table)))) | |
454 | (cond | |
455 | ((null name) comp) | |
456 | ((eq mail-complete-style 'parens) | |
457 | (concat (car name) " (" (cdr name) ")")) | |
458 | ((eq mail-complete-style 'angles) | |
459 | (concat (cdr name) " <" (car name) ">")) | |
460 | (t comp)))) | |
461 | (t | |
462 | (complete-with-action action table string pred))))) | |
463 | ||
464 | (defun mail-get-names (prefix) | |
e694581d | 465 | "Fetch local users and global mail addresses for completion. |
48919e0f | 466 | Consults `/etc/passwd' and a directory service if one is set up via |
e694581d | 467 | `mail-directory-function'. |
daca8ba5 | 468 | PREFIX is the string we want to complete." |
48919e0f | 469 | (if (eq mail-local-names t) |
9421bdd1 | 470 | (with-current-buffer (generate-new-buffer " passwd") |
8e3beae0 RS |
471 | (let ((files mail-passwd-files)) |
472 | (while files | |
473 | (insert-file-contents (car files) nil nil nil t) | |
474 | (setq files (cdr files)))) | |
475 | (if mail-passwd-command | |
476 | (call-process shell-file-name nil t nil | |
477 | shell-command-switch mail-passwd-command)) | |
637502c3 | 478 | (goto-char (point-min)) |
8e3beae0 | 479 | (setq mail-local-names nil) |
48919e0f | 480 | (while (not (eobp)) |
8bc49f8f RS |
481 | ;;Recognize lines like |
482 | ;; nobody:*:65534:65534::/: | |
483 | ;; +demo::::::/bin/csh | |
484 | ;; +ethanb | |
485 | ;;while skipping | |
486 | ;; +@SOFTWARE | |
e694581d RS |
487 | ;; The second \(...\) matches the user id. |
488 | (if (looking-at "\\+?\\([^:@\n+]+\\):[^:\n]*:\\([^\n:]*\\):") | |
489 | (add-to-list 'mail-local-names | |
490 | (cons (match-string 1) | |
491 | (user-full-name | |
027a4b6b | 492 | (string-to-number (match-string 2)))))) |
48919e0f RS |
493 | (beginning-of-line 2)) |
494 | (kill-buffer (current-buffer)))) | |
495 | (if (or (eq mail-names t) | |
e694581d | 496 | (eq mail-directory-names t)) |
48919e0f RS |
497 | (let (directory) |
498 | (and mail-directory-function | |
499 | (eq mail-directory-names t) | |
500 | (setq directory | |
daca8ba5 | 501 | (mail-directory (if mail-directory-requery prefix)))) |
e694581d RS |
502 | (or mail-directory-requery |
503 | (setq mail-directory-names directory)) | |
48919e0f RS |
504 | (if (or directory |
505 | (eq mail-names t)) | |
506 | (setq mail-names | |
e694581d RS |
507 | (sort (append (if (consp mail-aliases) |
508 | (mapcar | |
509 | (function (lambda (a) (list (car a)))) | |
510 | mail-aliases)) | |
48919e0f RS |
511 | (if (consp mail-local-names) |
512 | mail-local-names) | |
f6250436 RS |
513 | (or directory |
514 | (when (consp mail-directory-names) | |
515 | mail-directory-names))) | |
48919e0f | 516 | (lambda (a b) |
daca8ba5 | 517 | ;; Should cache downcased strings. |
48919e0f | 518 | (string< (downcase (car a)) |
e694581d | 519 | (downcase (car b))))))))) |
daca8ba5 | 520 | (mail-completion-expand mail-names)) |
48919e0f RS |
521 | |
522 | ||
daca8ba5 SM |
523 | (defun mail-directory (prefix) |
524 | "Use mail-directory facility to get user names matching PREFIX. | |
525 | If PREFIX is nil, get all the defined user names. | |
f6250436 RS |
526 | This function calls `mail-directory-function' to query the directory, |
527 | then uses `mail-directory-parser' to parse the output it returns." | |
9421bdd1 SM |
528 | (message "Querying directory...") |
529 | (with-current-buffer (generate-new-buffer " *mail-directory*") | |
daca8ba5 | 530 | (funcall mail-directory-function prefix) |
9421bdd1 | 531 | (goto-char (point-min)) |
48919e0f RS |
532 | (let (directory) |
533 | (if (stringp mail-directory-parser) | |
534 | (while (re-search-forward mail-directory-parser nil t) | |
daca8ba5 | 535 | (push (match-string 1) directory)) |
48919e0f RS |
536 | (if mail-directory-parser |
537 | (setq directory (funcall mail-directory-parser)) | |
538 | (while (not (eobp)) | |
daca8ba5 SM |
539 | (push (buffer-substring (point) |
540 | (progn | |
541 | (forward-line) | |
542 | (if (bolp) | |
543 | (1- (point)) | |
544 | (point)))) | |
545 | directory)))) | |
48919e0f RS |
546 | (kill-buffer (current-buffer)) |
547 | (message "Querying directory...done") | |
548 | directory))) | |
549 | ||
daca8ba5 | 550 | (defvar mailalias-done) |
48919e0f | 551 | |
daca8ba5 | 552 | (defun mail-directory-process (prefix) |
31407d5d | 553 | "Run a shell command to output names in directory. |
48919e0f | 554 | See `mail-directory-process'." |
f6250436 | 555 | (when (consp mail-directory-process) |
daca8ba5 SM |
556 | (let ((pattern prefix)) ;Dynbind! |
557 | (apply 'call-process (eval (car mail-directory-process)) nil t nil | |
558 | (mapcar 'eval (cdr mail-directory-process)))))) | |
48919e0f RS |
559 | |
560 | ;; This should handle a dialog. Currently expects port to spit out names. | |
daca8ba5 | 561 | (defun mail-directory-stream (prefix) |
48919e0f RS |
562 | "Open a stream to retrieve names in directory. |
563 | See `mail-directory-stream'." | |
daca8ba5 SM |
564 | (let ((mailalias-done nil) |
565 | (pattern prefix)) ;Dynbind! | |
48919e0f RS |
566 | (set-process-sentinel |
567 | (apply 'open-network-stream "mailalias" (current-buffer) | |
568 | mail-directory-stream) | |
daca8ba5 | 569 | (lambda (_x _y) |
48919e0f RS |
570 | (setq mailalias-done t))) |
571 | (while (not mailalias-done) | |
572 | (sit-for .1)))) | |
573 | ||
574 | (defun mail-sentto-newsgroups () | |
575 | "Return all entries from Newsgroups: header as completion alist." | |
576 | (save-excursion | |
577 | (if (mail-position-on-field "newsgroups" t) | |
578 | (let ((point (point)) | |
579 | list) | |
580 | (while (< (skip-chars-backward "^:, \t\n") 0) | |
581 | (setq list `((,(buffer-substring (point) point)) | |
582 | ,@list)) | |
583 | (skip-chars-backward ", \t\n") | |
584 | (setq point (point))) | |
585 | list)))) | |
6594deb0 | 586 | |
e8a57935 JB |
587 | (provide 'mailalias) |
588 | ||
6594deb0 | 589 | ;;; mailalias.el ends here |