Commit | Line | Data |
---|---|---|
48919e0f | 1 | ;;; mailalias.el --- expand and complete mailing address aliases |
6594deb0 | 2 | |
48919e0f | 3 | ;; Copyright (C) 1985, 1987, 1995, 1996 Free Software Foundation, Inc. |
3a801d0c | 4 | |
e5167999 | 5 | ;; Maintainer: FSF |
fd7fa35a | 6 | ;; Keywords: mail |
e5167999 | 7 | |
80a677d9 JA |
8 | ;; This file is part of GNU Emacs. |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
80a677d9 JA |
13 | ;; any later version. |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
80a677d9 | 24 | |
e41b2db1 ER |
25 | ;;; Commentary: |
26 | ||
27 | ;; Basic functions for defining and expanding mail aliases. | |
28 | ;; These seal off the interface to the alias-definition parts of a | |
29 | ;; .mailrc file formatted for BSD's Mail or USL's mailx. | |
30 | ||
e5167999 | 31 | ;;; Code: |
80a677d9 | 32 | |
594906dd | 33 | (require 'sendmail) |
c2db7f31 | 34 | |
48919e0f RS |
35 | (defvar mail-names t |
36 | "Alist of local users, aliases and directory entries as available. | |
37 | When t this still needs to be initialized. | |
38 | This is the basis for `mail-complete'.") | |
39 | ||
40 | (defvar mail-local-names t | |
41 | "Alist of local users. | |
42 | When t this still needs to be initialized.") | |
43 | ||
8e3beae0 RS |
44 | (defvar mail-passwd-files '("/etc/passwd") |
45 | "List of files from which to determine valid user names.") | |
46 | ||
47 | (defvar mail-passwd-command nil | |
48 | "Shell command to retrieve text to add to `/etc/passwd', or nil.") | |
49 | ||
48919e0f RS |
50 | (defvar mail-directory-names t |
51 | "Alist of mail address directory entries. | |
52 | When t this still needs to be initialized.") | |
53 | ||
54 | (defvar mail-address-field-regexp | |
55 | "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):") | |
56 | ||
57 | (defvar mail-complete-alist | |
58 | `((,mail-address-field-regexp mail-get-names pattern) | |
59 | ("Newsgroups:" . (if (boundp 'gnus-active-hashtb) | |
60 | gnus-active-hashtb | |
61 | (if (boundp news-group-article-assoc) | |
62 | news-group-article-assoc))) | |
63 | ("Followup-To:" . (mail-sentto-newsgroups)) | |
64 | ;;("Distribution:" ???) | |
65 | ) | |
66 | "Alist of header field and expression to return alist for completion. | |
67 | Expression may reference variable `pattern' which is the string being completed. | |
68 | If not on matching header, `mail-complete-function' gets called instead.") | |
69 | ||
70 | (defvar mail-complete-function 'ispell-complete-word | |
71 | "Function to call when completing outside `mail-complete-alist'-header.") | |
72 | ||
73 | ||
74 | (defvar mail-directory-function nil | |
75 | "Function to get completions from directory service or `nil' for none. | |
76 | See `mail-directory-requery'.") | |
77 | ||
78 | ||
79 | ;; This is for when the directory is huge, or changes frequently. | |
80 | (defvar mail-directory-requery nil | |
81 | "When non-`nil' call `mail-directory-function' for each completion. | |
82 | In that case, one argument gets passed to the function, the partial string | |
83 | entered so far.") | |
84 | ||
85 | ||
86 | (defvar mail-directory-process nil | |
87 | "Unix command when `mail-directory-function' is `mail-directory-process'. | |
88 | This is a list of the form (COMMAND ARG ...), where each of the list elements | |
89 | is evaluated. When `mail-directory-requery' is non-`nil', during | |
90 | evaluation the variable `pattern' contains the partial input being completed. | |
91 | This might look like | |
92 | ||
93 | '(remote-shell-program \"HOST\" \"-nl\" \"USER\" \"COMMAND\") | |
94 | ||
95 | or | |
96 | ||
97 | '(remote-shell-program \"HOST\" \"-n\" \"COMMAND '^\" pattern \"'\")") | |
98 | ||
99 | (defvar mail-directory-stream () | |
100 | "List of (HOST SERVICE) for stream connection to mail directory.") | |
101 | ||
102 | (defvar mail-directory-parser nil | |
103 | "How to interpret the output of `mail-directory-function'. | |
104 | Three types of values are possible: | |
105 | ||
106 | - nil means to gather each line as one name | |
107 | - regexp means first \\(grouping\\) in successive matches is name | |
108 | - function called at beginning of buffer that returns an alist of names") | |
109 | ||
110 | ||
80a677d9 JA |
111 | ;; Called from sendmail-send-it, or similar functions, |
112 | ;; only if some mail aliases are defined. | |
113 | (defun expand-mail-aliases (beg end &optional exclude) | |
114 | "Expand all mail aliases in suitable header fields found between BEG and END. | |
1abe8488 KH |
115 | Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and |
116 | their `Resent-' variants. | |
117 | ||
96846422 RS |
118 | Optional second arg EXCLUDE may be a regular expression defining text to be |
119 | removed from alias expansions." | |
e934d700 | 120 | (sendmail-sync-aliases) |
80a677d9 JA |
121 | (if (eq mail-aliases t) |
122 | (progn (setq mail-aliases nil) (build-mail-aliases))) | |
123 | (goto-char beg) | |
124 | (setq end (set-marker (make-marker) end)) | |
125 | (let ((case-fold-search nil)) | |
126 | (while (let ((case-fold-search t)) | |
48919e0f | 127 | (re-search-forward mail-address-field-regexp end t)) |
80a677d9 JA |
128 | (skip-chars-forward " \t") |
129 | (let ((beg1 (point)) | |
130 | end1 pos epos seplen | |
131 | ;; DISABLED-ALIASES records aliases temporarily disabled | |
132 | ;; while we scan text that resulted from expanding those aliases. | |
133 | ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN | |
134 | ;; is where to reenable the alias (expressed as number of chars | |
135 | ;; counting from END1). | |
136 | (disabled-aliases nil)) | |
137 | (re-search-forward "^[^ \t]" end 'move) | |
138 | (beginning-of-line) | |
139 | (skip-chars-backward " \t\n") | |
140 | (setq end1 (point-marker)) | |
141 | (goto-char beg1) | |
142 | (while (< (point) end1) | |
143 | (setq pos (point)) | |
144 | ;; Reenable any aliases which were disabled for ranges | |
145 | ;; that we have passed out of. | |
146 | (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases))))) | |
147 | (setq disabled-aliases (cdr disabled-aliases))) | |
148 | ;; EPOS gets position of end of next name; | |
149 | ;; SEPLEN gets length of whitespace&separator that follows it. | |
150 | (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t) | |
151 | (setq epos (match-beginning 0) | |
152 | seplen (- (point) epos)) | |
153 | (setq epos (marker-position end1) seplen 0)) | |
154 | (let (translation | |
2bc9b0c7 | 155 | (string (buffer-substring-no-properties pos epos))) |
80a677d9 JA |
156 | (if (and (not (assoc string disabled-aliases)) |
157 | (setq translation | |
158 | (cdr (assoc string mail-aliases)))) | |
159 | (progn | |
160 | ;; This name is an alias. Disable it. | |
161 | (setq disabled-aliases (cons (cons string (- end1 epos)) | |
162 | disabled-aliases)) | |
163 | ;; Replace the alias with its expansion | |
164 | ;; then rescan the expansion for more aliases. | |
165 | (goto-char pos) | |
166 | (insert translation) | |
167 | (if exclude | |
168 | (let ((regexp | |
169 | (concat "\\b\\(" exclude "\\)\\b")) | |
170 | (end (point-marker))) | |
171 | (goto-char pos) | |
172 | (while (re-search-forward regexp end t) | |
173 | (replace-match "")) | |
174 | (goto-char end))) | |
175 | (delete-region (point) (+ (point) (- epos pos))) | |
176 | (goto-char pos)) | |
177 | ;; Name is not an alias. Skip to start of next name. | |
178 | (goto-char epos) | |
179 | (forward-char seplen)))) | |
180 | (set-marker end1 nil))) | |
181 | (set-marker end nil))) | |
182 | ||
9d73ab0d NF |
183 | ;; Called by mail-setup, or similar functions, only if the file specified |
184 | ;; by mail-personal-alias-file (usually `~/.mailrc') exists. | |
80a677d9 | 185 | (defun build-mail-aliases (&optional file) |
9d73ab0d NF |
186 | "Read mail aliases from personal aliases file and set `mail-aliases'. |
187 | By default, this is the file specified by `mail-personal-alias-file'." | |
188 | (setq file (expand-file-name (or file mail-personal-alias-file))) | |
80a677d9 JA |
189 | (let ((buffer nil) |
190 | (obuf (current-buffer))) | |
191 | (unwind-protect | |
192 | (progn | |
48919e0f | 193 | (setq buffer (generate-new-buffer " mailrc")) |
80a677d9 | 194 | (set-buffer buffer) |
3c55fda0 RS |
195 | (while file |
196 | (cond ((get-file-buffer file) | |
197 | (insert (save-excursion | |
198 | (set-buffer (get-file-buffer file)) | |
599d82c8 RS |
199 | (buffer-substring-no-properties |
200 | (point-min) (point-max))))) | |
3c55fda0 RS |
201 | ((file-exists-p file) (insert-file-contents file)) |
202 | ((file-exists-p (setq file (concat "~/" file))) | |
203 | (insert-file-contents file)) | |
204 | (t (setq file nil))) | |
205 | ;; Don't lose if no final newline. | |
206 | (goto-char (point-max)) | |
207 | (or (eq (preceding-char) ?\n) (newline)) | |
208 | (goto-char (point-min)) | |
209 | ;; handle "\\\n" continuation lines | |
210 | (while (not (eobp)) | |
211 | (end-of-line) | |
212 | (if (= (preceding-char) ?\\) | |
213 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
80a677d9 | 214 | (forward-char 1))) |
3c55fda0 RS |
215 | (goto-char (point-min)) |
216 | ;; handle `source' directives -- Eddy/1994/May/25 | |
217 | (cond ((re-search-forward "^source[ \t]+" nil t) | |
218 | (re-search-forward "\\S-+") | |
599d82c8 RS |
219 | (setq file (buffer-substring-no-properties |
220 | (match-beginning 0) (match-end 0))) | |
3c55fda0 RS |
221 | (beginning-of-line) |
222 | (insert "# ") ; to ensure we don't re-process this file | |
223 | (beginning-of-line)) | |
224 | (t (setq file nil)))) | |
80a677d9 | 225 | (goto-char (point-min)) |
d9817d8c FP |
226 | (while (re-search-forward |
227 | "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t]+\\)" nil t) | |
228 | (let* ((name (match-string 2)) | |
80a677d9 JA |
229 | (start (progn (skip-chars-forward " \t") (point)))) |
230 | (end-of-line) | |
231 | (define-mail-alias | |
232 | name | |
599d82c8 | 233 | (buffer-substring-no-properties start (point)) |
37e379dd | 234 | t))) |
80a677d9 JA |
235 | mail-aliases) |
236 | (if buffer (kill-buffer buffer)) | |
237 | (set-buffer obuf)))) | |
238 | ||
239 | ;; Always autoloadable in case the user wants to define aliases | |
240 | ;; interactively or in .emacs. | |
7229064d | 241 | ;;;###autoload |
37e379dd | 242 | (defun define-mail-alias (name definition &optional from-mailrc-file) |
96846422 | 243 | "Define NAME as a mail alias that translates to DEFINITION. |
80a677d9 | 244 | This means that sending a message to NAME will actually send to DEFINITION. |
fa786521 RS |
245 | |
246 | Normally, the addresses in DEFINITION must be separated by commas. | |
247 | If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION | |
248 | can be separated by spaces; an address can contain spaces | |
249 | if it is quoted with double-quotes." | |
250 | ||
80a677d9 JA |
251 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") |
252 | ;; Read the defaults first, if we have not done so. | |
e934d700 | 253 | (sendmail-sync-aliases) |
80a677d9 JA |
254 | (if (eq mail-aliases t) |
255 | (progn | |
256 | (setq mail-aliases nil) | |
9d73ab0d | 257 | (if (file-exists-p mail-personal-alias-file) |
80a677d9 | 258 | (build-mail-aliases)))) |
3af1a1f3 RS |
259 | ;; strip garbage from front and end |
260 | (if (string-match "\\`[ \t\n,]+" definition) | |
aa228418 | 261 | (setq definition (substring definition (match-end 0)))) |
3af1a1f3 | 262 | (if (string-match "[ \t\n,]+\\'" definition) |
aa228418 | 263 | (setq definition (substring definition 0 (match-beginning 0)))) |
37e379dd | 264 | (let ((result '()) |
cc4b6c02 RS |
265 | ;; If DEFINITION is null string, avoid looping even once. |
266 | (start (and (not (equal definition "")) 0)) | |
37e379dd RS |
267 | (L (length definition)) |
268 | end tem) | |
269 | (while start | |
270 | ;; If we're reading from the mailrc file, then addresses are delimited | |
271 | ;; by spaces, and addresses with embedded spaces must be surrounded by | |
272 | ;; double-quotes. Otherwise, addresses are separated by commas. | |
273 | (if from-mailrc-file | |
274 | (if (eq ?\" (aref definition start)) | |
275 | (setq start (1+ start) | |
276 | end (string-match "\"[ \t,]*" definition start)) | |
cc4b6c02 RS |
277 | (setq end (string-match "[ \t,]+" definition start))) |
278 | (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) | |
37e379dd RS |
279 | (setq result (cons (substring definition start end) result)) |
280 | (setq start (and end | |
281 | (/= (match-end 0) L) | |
282 | (match-end 0)))) | |
283 | (setq definition (mapconcat (function identity) | |
284 | (nreverse result) | |
285 | ", ")) | |
80a677d9 JA |
286 | (setq tem (assoc name mail-aliases)) |
287 | (if tem | |
288 | (rplacd tem definition) | |
48919e0f RS |
289 | (setq mail-aliases (cons (cons name definition) mail-aliases) |
290 | mail-names t)))) | |
291 | ||
c0fd4267 | 292 | ;;;###autoload |
48919e0f RS |
293 | (defun mail-complete (arg) |
294 | "Perform completion on header field or word preceding point. | |
295 | Completable headers are according to `mail-complete-alist'. If none matches | |
296 | current header, calls `mail-complete-function' and passes prefix arg if any." | |
297 | (interactive "P") | |
9a03a6f4 SM |
298 | ;; Read the defaults first, if we have not done so. |
299 | (sendmail-sync-aliases) | |
300 | (if (eq mail-aliases t) | |
301 | (progn | |
302 | (setq mail-aliases nil) | |
303 | (if (file-exists-p mail-personal-alias-file) | |
304 | (build-mail-aliases)))) | |
48919e0f RS |
305 | (let ((list mail-complete-alist)) |
306 | (if (and (save-excursion (search-forward | |
307 | (concat "\n" mail-header-separator "\n") | |
308 | nil t)) | |
309 | (save-excursion | |
310 | (if (re-search-backward "^[^\t]" nil t) | |
311 | (while list | |
312 | (if (looking-at (car (car list))) | |
313 | (setq arg (cdr (car list)) | |
314 | list ()) | |
315 | (setq list (cdr list))))) | |
316 | arg)) | |
317 | (let* ((end (point)) | |
318 | (beg (save-excursion | |
319 | (skip-chars-backward "^ \t<,:") | |
320 | (point))) | |
321 | (pattern (buffer-substring beg end)) | |
322 | completion) | |
323 | (setq list (eval arg) | |
324 | completion (try-completion pattern list)) | |
325 | (cond ((eq completion t)) | |
326 | ((null completion) | |
327 | (message "Can't find completion for \"%s\"" pattern) | |
328 | (ding)) | |
329 | ((not (string= pattern completion)) | |
330 | (delete-region beg end) | |
331 | (insert completion)) | |
332 | (t | |
333 | (message "Making completion list...") | |
334 | (with-output-to-temp-buffer "*Completions*" | |
335 | (display-completion-list | |
336 | (all-completions pattern list))) | |
337 | (message "Making completion list...%s" "done")))) | |
338 | (funcall mail-complete-function arg)))) | |
339 | ||
340 | (defun mail-get-names (pattern) | |
341 | "Fetch local users and global mail adresses for completion. | |
342 | Consults `/etc/passwd' and a directory service if one is set up via | |
343 | `mail-directory-function'." | |
344 | (if (eq mail-local-names t) | |
345 | (save-excursion | |
346 | (set-buffer (generate-new-buffer " passwd")) | |
8e3beae0 RS |
347 | (let ((files mail-passwd-files)) |
348 | (while files | |
349 | (insert-file-contents (car files) nil nil nil t) | |
350 | (setq files (cdr files)))) | |
351 | (if mail-passwd-command | |
352 | (call-process shell-file-name nil t nil | |
353 | shell-command-switch mail-passwd-command)) | |
354 | (setq mail-local-names nil) | |
48919e0f | 355 | (while (not (eobp)) |
8bc49f8f RS |
356 | ;;Recognize lines like |
357 | ;; nobody:*:65534:65534::/: | |
358 | ;; +demo::::::/bin/csh | |
359 | ;; +ethanb | |
360 | ;;while skipping | |
361 | ;; +@SOFTWARE | |
362 | (if (looking-at "\\+?\\([^:@\n+]+\\)") | |
363 | (add-to-list 'mail-local-names (list (match-string 1)))) | |
48919e0f RS |
364 | (beginning-of-line 2)) |
365 | (kill-buffer (current-buffer)))) | |
366 | (if (or (eq mail-names t) | |
367 | (eq mail-directory-names t)) | |
368 | (let (directory) | |
369 | (and mail-directory-function | |
370 | (eq mail-directory-names t) | |
371 | (setq directory | |
372 | (mail-directory (if mail-directory-requery pattern)))) | |
373 | (if (or directory | |
374 | (eq mail-names t)) | |
375 | (setq mail-names | |
376 | (sort (append (if (consp mail-aliases) mail-aliases) | |
377 | (if (consp mail-local-names) | |
378 | mail-local-names) | |
379 | directory) | |
380 | (lambda (a b) | |
381 | ;; should cache downcased strings | |
382 | (string< (downcase (car a)) | |
383 | (downcase (car b))))))) | |
384 | (or mail-directory-requery | |
385 | (setq mail-directory-names directory)))) | |
386 | mail-names) | |
387 | ||
388 | ||
389 | (defun mail-directory (pattern) | |
390 | "Call directory to get names matching PATTERN or all if `nil'. | |
391 | Calls `mail-directory-function' and applies `mail-directory-parser' to output." | |
392 | (save-excursion | |
393 | (message "Querying directory...") | |
394 | (set-buffer (generate-new-buffer " *mail-directory*")) | |
395 | (funcall mail-directory-function pattern) | |
396 | (goto-char 1) | |
397 | (let (directory) | |
398 | (if (stringp mail-directory-parser) | |
399 | (while (re-search-forward mail-directory-parser nil t) | |
400 | (setq directory | |
401 | `((,(match-string 1)) | |
402 | ,@directory))) | |
403 | (if mail-directory-parser | |
404 | (setq directory (funcall mail-directory-parser)) | |
405 | (while (not (eobp)) | |
406 | (setq directory | |
407 | `((,(buffer-substring (point) | |
408 | (progn | |
409 | (forward-line) | |
410 | (if (bolp) | |
411 | (1- (point)) | |
412 | (point))))) | |
413 | ,@directory))))) | |
414 | (kill-buffer (current-buffer)) | |
415 | (message "Querying directory...done") | |
416 | directory))) | |
417 | ||
418 | ||
419 | (defun mail-directory-process (pattern) | |
420 | "Call a Unix process to output names in directory. | |
421 | See `mail-directory-process'." | |
422 | (apply 'call-process (eval (car mail-directory-process)) nil t nil | |
423 | (mapcar 'eval (cdr mail-directory-process)))) | |
424 | ||
425 | ;; This should handle a dialog. Currently expects port to spit out names. | |
426 | (defun mail-directory-stream (pattern) | |
427 | "Open a stream to retrieve names in directory. | |
428 | See `mail-directory-stream'." | |
429 | (let (mailalias-done) | |
430 | (set-process-sentinel | |
431 | (apply 'open-network-stream "mailalias" (current-buffer) | |
432 | mail-directory-stream) | |
433 | (lambda (x x) | |
434 | (setq mailalias-done t))) | |
435 | (while (not mailalias-done) | |
436 | (sit-for .1)))) | |
437 | ||
438 | (defun mail-sentto-newsgroups () | |
439 | "Return all entries from Newsgroups: header as completion alist." | |
440 | (save-excursion | |
441 | (if (mail-position-on-field "newsgroups" t) | |
442 | (let ((point (point)) | |
443 | list) | |
444 | (while (< (skip-chars-backward "^:, \t\n") 0) | |
445 | (setq list `((,(buffer-substring (point) point)) | |
446 | ,@list)) | |
447 | (skip-chars-backward ", \t\n") | |
448 | (setq point (point))) | |
449 | list)))) | |
6594deb0 | 450 | |
e8a57935 JB |
451 | (provide 'mailalias) |
452 | ||
6594deb0 | 453 | ;;; mailalias.el ends here |