1 ;;; mailalias.el --- expand mailing address aliases defined in ~/.mailrc.
3 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
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
12 ;; the Free Software Foundation; either version 2, or (at your option)
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; Called from sendmail-send-it, or similar functions,
27 ;; only if some mail aliases are defined.
28 (defun expand-mail-aliases (beg end
&optional exclude
)
29 "Expand all mail aliases in suitable header fields found between BEG and END.
30 Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
31 Optional second arg EXCLUDE may be a regular expression defining text to be
32 removed from alias expansions."
33 (if (eq mail-aliases t
)
34 (progn (setq mail-aliases nil
) (build-mail-aliases)))
36 (setq end
(set-marker (make-marker) end
))
37 (let ((case-fold-search nil
))
38 (while (let ((case-fold-search t
))
39 (re-search-forward "^\\(to\\|cc\\|bcc\\|resent-to\\|resent-cc\\|resent-bcc\\):" end t
))
40 (skip-chars-forward " \t")
43 ;; DISABLED-ALIASES records aliases temporarily disabled
44 ;; while we scan text that resulted from expanding those aliases.
45 ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
46 ;; is where to reenable the alias (expressed as number of chars
47 ;; counting from END1).
48 (disabled-aliases nil
))
49 (re-search-forward "^[^ \t]" end
'move
)
51 (skip-chars-backward " \t\n")
52 (setq end1
(point-marker))
54 (while (< (point) end1
)
56 ;; Reenable any aliases which were disabled for ranges
57 ;; that we have passed out of.
58 (while (and disabled-aliases
(> pos
(- end1
(cdr (car disabled-aliases
)))))
59 (setq disabled-aliases
(cdr disabled-aliases
)))
60 ;; EPOS gets position of end of next name;
61 ;; SEPLEN gets length of whitespace&separator that follows it.
62 (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t
)
63 (setq epos
(match-beginning 0)
64 seplen
(- (point) epos
))
65 (setq epos
(marker-position end1
) seplen
0))
67 (string (buffer-substring pos epos
)))
68 (if (and (not (assoc string disabled-aliases
))
70 (cdr (assoc string mail-aliases
))))
72 ;; This name is an alias. Disable it.
73 (setq disabled-aliases
(cons (cons string
(- end1 epos
))
75 ;; Replace the alias with its expansion
76 ;; then rescan the expansion for more aliases.
81 (concat "\\b\\(" exclude
"\\)\\b"))
84 (while (re-search-forward regexp end t
)
87 (delete-region (point) (+ (point) (- epos pos
)))
89 ;; Name is not an alias. Skip to start of next name.
91 (forward-char seplen
))))
92 (set-marker end1 nil
)))
93 (set-marker end nil
)))
95 ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
96 (defun build-mail-aliases (&optional file
)
97 "Read mail aliases from `~/.mailrc' and set `mail-aliases'."
98 (setq file
(expand-file-name (or file
"~/.mailrc")))
100 (obuf (current-buffer)))
103 (setq buffer
(generate-new-buffer "mailrc"))
104 (buffer-disable-undo buffer
)
106 (cond ((get-file-buffer file
)
107 (insert (save-excursion
108 (set-buffer (get-file-buffer file
))
109 (buffer-substring (point-min) (point-max)))))
110 ((not (file-exists-p file
)))
111 (t (insert-file-contents file
)))
112 ;; Don't lose if no final newline.
113 (goto-char (point-max))
114 (or (eq (preceding-char) ?
\n) (newline))
115 (goto-char (point-min))
116 ;; handle "\\\n" continuation lines
119 (if (= (preceding-char) ?
\\)
120 (progn (delete-char -
1) (delete-char 1) (insert ?\
))
122 (goto-char (point-min))
123 (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t
)
124 (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t
))
125 (re-search-forward "[^ \t]+")
126 (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
127 (start (progn (skip-chars-forward " \t") (point))))
131 (buffer-substring start
(point)))))
133 (if buffer
(kill-buffer buffer
))
136 ;; Always autoloadable in case the user wants to define aliases
137 ;; interactively or in .emacs.
139 (defun define-mail-alias (name definition
)
140 "Define NAME as a mail alias that translates to DEFINITION.
141 This means that sending a message to NAME will actually send to DEFINITION.
142 DEFINITION can be one or more mail addresses separated by commas."
143 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
144 ;; Read the defaults first, if we have not done so.
145 (if (eq mail-aliases t
)
147 (setq mail-aliases nil
)
148 (if (file-exists-p "~/.mailrc")
149 (build-mail-aliases))))
150 ;; Strip leading and trailing blanks.
151 (if (string-match "^[ \t]+" definition
)
152 (setq definition
(substring definition
(match-end 0))))
153 (if (string-match "[ \t]+$" definition
)
154 (setq definition
(substring definition
0 (match-beginning 0))))
155 (let ((first (aref definition
0))
156 (last (aref definition
(1- (length definition
))))
158 (if (and (= first last
) (memq first
'(?
\' ?
\")))
159 ;; Strip quotation marks.
160 (setq definition
(substring definition
1 (1- (length definition
))))
161 ;; ~/.mailrc contains addresses separated by spaces.
162 ;; mailers should expect addresses separated by commas.
163 (while (setq tem
(string-match "[^ \t,][ \t,]+" definition tem
))
164 (if (= (match-end 0) (length definition
))
165 (setq definition
(substring definition
0 (1+ tem
)))
166 (setq definition
(concat (substring definition
169 (substring definition
(match-end 0))))
170 (setq tem
(+ 3 tem
)))))
171 (setq tem
(assoc name mail-aliases
))
173 (rplacd tem definition
)
174 (setq mail-aliases
(cons (cons name definition
) mail-aliases
)))))
178 ;;; mailalias.el ends here