1 ;;; mailalias.el --- expand mailing address aliases defined in ~/.mailrc.
3 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 1, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22 ;; Called from sendmail-send-it, or similar functions,
23 ;; only if some mail aliases are defined.
24 (defun expand-mail-aliases (beg end
&optional exclude
)
25 "Expand all mail aliases in suitable header fields found between BEG and END.
26 Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
27 Optional second arg EXCLUDE may be a regular expression defining text to be
28 removed from alias expansions."
29 (if (eq mail-aliases t
)
30 (progn (setq mail-aliases nil
) (build-mail-aliases)))
32 (setq end
(set-marker (make-marker) end
))
33 (let ((case-fold-search nil
))
34 (while (let ((case-fold-search t
))
35 (re-search-forward "^\\(to\\|cc\\|bcc\\|resent-to\\|resent-cc\\|resent-bcc\\):" end t
))
36 (skip-chars-forward " \t")
39 ;; DISABLED-ALIASES records aliases temporarily disabled
40 ;; while we scan text that resulted from expanding those aliases.
41 ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
42 ;; is where to reenable the alias (expressed as number of chars
43 ;; counting from END1).
44 (disabled-aliases nil
))
45 (re-search-forward "^[^ \t]" end
'move
)
47 (skip-chars-backward " \t\n")
48 (setq end1
(point-marker))
50 (while (< (point) end1
)
52 ;; Reenable any aliases which were disabled for ranges
53 ;; that we have passed out of.
54 (while (and disabled-aliases
(> pos
(- end1
(cdr (car disabled-aliases
)))))
55 (setq disabled-aliases
(cdr disabled-aliases
)))
56 ;; EPOS gets position of end of next name;
57 ;; SEPLEN gets length of whitespace&separator that follows it.
58 (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t
)
59 (setq epos
(match-beginning 0)
60 seplen
(- (point) epos
))
61 (setq epos
(marker-position end1
) seplen
0))
63 (string (buffer-substring pos epos
)))
64 (if (and (not (assoc string disabled-aliases
))
66 (cdr (assoc string mail-aliases
))))
68 ;; This name is an alias. Disable it.
69 (setq disabled-aliases
(cons (cons string
(- end1 epos
))
71 ;; Replace the alias with its expansion
72 ;; then rescan the expansion for more aliases.
77 (concat "\\b\\(" exclude
"\\)\\b"))
80 (while (re-search-forward regexp end t
)
83 (delete-region (point) (+ (point) (- epos pos
)))
85 ;; Name is not an alias. Skip to start of next name.
87 (forward-char seplen
))))
88 (set-marker end1 nil
)))
89 (set-marker end nil
)))
91 ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
92 (defun build-mail-aliases (&optional file
)
93 "Read mail aliases from ~/.mailrc and set `mail-aliases'."
94 (setq file
(expand-file-name (or file
"~/.mailrc")))
96 (obuf (current-buffer)))
99 (setq buffer
(generate-new-buffer "mailrc"))
100 (buffer-disable-undo buffer
)
102 (cond ((get-file-buffer file
)
103 (insert (save-excursion
104 (set-buffer (get-file-buffer file
))
105 (buffer-substring (point-min) (point-max)))))
106 ((not (file-exists-p file
)))
107 (t (insert-file-contents file
)))
108 ;; Don't lose if no final newline.
109 (goto-char (point-max))
110 (or (eq (preceding-char) ?
\n) (newline))
111 (goto-char (point-min))
112 ;; handle "\\\n" continuation lines
115 (if (= (preceding-char) ?
\\)
116 (progn (delete-char -
1) (delete-char 1) (insert ?\
))
118 (goto-char (point-min))
119 (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t
)
120 (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t
))
121 (re-search-forward "[^ \t]+")
122 (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
123 (start (progn (skip-chars-forward " \t") (point))))
127 (buffer-substring start
(point)))))
129 (if buffer
(kill-buffer buffer
))
132 ;; Always autoloadable in case the user wants to define aliases
133 ;; interactively or in .emacs.
135 (defun define-mail-alias (name definition
)
136 "Define NAME as a mail alias that translates to DEFINITION.
137 This means that sending a message to NAME will actually send to DEFINITION.
138 DEFINITION can be one or more mail addresses separated by commas."
139 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
140 ;; Read the defaults first, if we have not done so.
141 (if (eq mail-aliases t
)
143 (setq mail-aliases nil
)
144 (if (file-exists-p "~/.mailrc")
145 (build-mail-aliases))))
146 ;; Strip leading and trailing blanks.
147 (if (string-match "^[ \t]+" definition
)
148 (setq definition
(substring definition
(match-end 0))))
149 (if (string-match "[ \t]+$" definition
)
150 (setq definition
(substring definition
0 (match-beginning 0))))
151 (let ((first (aref definition
0))
152 (last (aref definition
(1- (length definition
))))
154 (if (and (= first last
) (memq first
'(?
\' ?
\")))
155 ;; Strip quotation marks.
156 (setq definition
(substring definition
1 (1- (length definition
))))
157 ;; ~/.mailrc contains addresses separated by spaces.
158 ;; mailers should expect addresses separated by commas.
159 (while (setq tem
(string-match "[^ \t,][ \t,]+" definition tem
))
160 (if (= (match-end 0) (length definition
))
161 (setq definition
(substring definition
0 (1+ tem
)))
162 (setq definition
(concat (substring definition
165 (substring definition
(match-end 0))))
166 (setq tem
(+ 3 tem
)))))
167 (setq tem
(assoc name mail-aliases
))
169 (rplacd tem definition
)
170 (setq mail-aliases
(cons (cons name definition
) mail-aliases
)))))
172 ;;; mailalias.el ends here