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 (defvar mail-aliases t
27 "Alias of mail address aliases,
28 or t meaning should be initialized from `~/.mailrc'.")
30 ;; Called from sendmail-send-it, or similar functions,
31 ;; only if some mail aliases are defined.
32 (defun expand-mail-aliases (beg end &optional exclude)
33 "Expand all mail aliases in suitable header fields found between BEG and END.
34 Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
35 Optional second arg EXCLUDE may be a regular expression defining text to be
36 removed from alias expansions."
37 (if (eq mail-aliases t)
38 (progn (setq mail-aliases nil) (build-mail-aliases)))
40 (setq end (set-marker (make-marker) end))
41 (let ((case-fold-search nil))
42 (while (let ((case-fold-search t))
43 (re-search-forward "^\\(to\\|cc\\|bcc\\|resent-to\\|resent-cc\\|resent-bcc\\):" end t))
44 (skip-chars-forward " \t")
47 ;; DISABLED-ALIASES records aliases temporarily disabled
48 ;; while we scan text that resulted from expanding those aliases.
49 ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
50 ;; is where to reenable the alias (expressed as number of chars
51 ;; counting from END1).
52 (disabled-aliases nil))
53 (re-search-forward "^[^ \t]" end 'move)
55 (skip-chars-backward " \t\n")
56 (setq end1 (point-marker))
58 (while (< (point) end1)
60 ;; Reenable any aliases which were disabled for ranges
61 ;; that we have passed out of.
62 (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
63 (setq disabled-aliases (cdr disabled-aliases)))
64 ;; EPOS gets position of end of next name;
65 ;; SEPLEN gets length of whitespace&separator that follows it.
66 (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
67 (setq epos (match-beginning 0)
68 seplen (- (point) epos))
69 (setq epos (marker-position end1) seplen 0))
71 (string (buffer-substring pos epos)))
72 (if (and (not (assoc string disabled-aliases))
74 (cdr (assoc string mail-aliases))))
76 ;; This name is an alias. Disable it.
77 (setq disabled-aliases (cons (cons string (- end1 epos))
79 ;; Replace the alias with its expansion
80 ;; then rescan the expansion for more aliases.
85 (concat "\\b\\(" exclude "\\)\\b"))
88 (while (re-search-forward regexp end t)
91 (delete-region (point) (+ (point) (- epos pos)))
93 ;; Name is not an alias. Skip to start of next name.
95 (forward-char seplen))))
96 (set-marker end1 nil)))
97 (set-marker end nil)))
99 ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
100 (defun build-mail-aliases (&optional file)
101 "Read mail aliases from `~/.mailrc' and set `mail-aliases'."
102 (setq file (expand-file-name (or file "~/.mailrc")))
104 (obuf (current-buffer)))
107 (setq buffer (generate-new-buffer "mailrc"))
108 (buffer-disable-undo buffer)
110 (cond ((get-file-buffer file)
111 (insert (save-excursion
112 (set-buffer (get-file-buffer file))
113 (buffer-substring (point-min) (point-max)))))
114 ((not (file-exists-p file)))
115 (t (insert-file-contents file)))
116 ;; Don't lose if no final newline.
117 (goto-char (point-max))
118 (or (eq (preceding-char) ?\n) (newline))
119 (goto-char (point-min))
120 ;; handle "\\\n" continuation lines
123 (if (= (preceding-char) ?\\)
124 (progn (delete-char -1) (delete-char 1) (insert ?\ ))
126 (goto-char (point-min))
127 (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
128 (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
129 (re-search-forward "[^ \t]+")
130 (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
131 (start (progn (skip-chars-forward " \t") (point))))
135 (buffer-substring start (point)))))
137 (if buffer (kill-buffer buffer))
140 ;; Always autoloadable in case the user wants to define aliases
141 ;; interactively or in .emacs.
143 (defun define-mail-alias (name definition)
144 "Define NAME as a mail alias that translates to DEFINITION.
145 This means that sending a message to NAME will actually send to DEFINITION.
146 DEFINITION can be one or more mail addresses separated by commas."
147 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
148 ;; Read the defaults first, if we have not done so.
149 (if (eq mail-aliases t)
151 (setq mail-aliases nil)
152 (if (file-exists-p "~/.mailrc")
153 (build-mail-aliases))))
154 ;; Strip leading and trailing blanks.
155 (if (string-match "^[ \t]+" definition)
156 (setq definition (substring definition (match-end 0))))
157 (if (string-match "[ \t]+$" definition)
158 (setq definition (substring definition 0 (match-beginning 0))))
159 (let ((first (aref definition 0))
160 (last (aref definition (1- (length definition))))
162 (if (and (= first last) (memq first '(?\' ?\")))
163 ;; Strip quotation marks.
164 (setq definition (substring definition 1 (1- (length definition))))
165 ;; ~/.mailrc contains addresses separated by spaces.
166 ;; mailers should expect addresses separated by commas.
167 (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
168 (if (= (match-end 0) (length definition))
169 (setq definition (substring definition 0 (1+ tem)))
170 (setq definition (concat (substring definition
173 (substring definition (match-end 0))))
174 (setq tem (+ 3 tem)))))
175 (setq tem (assoc name mail-aliases))
177 (rplacd tem definition)
178 (setq mail-aliases (cons (cons name definition) mail-aliases)))))
182 ;;; mailalias.el ends here