1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
;; Expand mailing address aliases defined in ~/.mailrc.
;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Called from sendmail-send-it, or similar functions,
;; only if some mail aliases are defined.
(defun expand-mail-aliases (beg end)
"Expand all mail aliases in suitable header fields found between BEG and END.
Suitable header fields are To, Cc and Bcc."
(if (eq mail-aliases t)
(progn (setq mail-aliases nil) (build-mail-aliases)))
(goto-char beg)
(setq end (set-marker (make-marker) end))
(let ((case-fold-search nil))
(while (let ((case-fold-search t))
(re-search-forward "^\\(to\\|cc\\|bcc\\):" end t))
(skip-chars-forward " \t")
(let ((beg1 (point))
end1 pos epos seplen
;; DISABLED-ALIASES records aliases temporarily disabled
;; while we scan text that resulted from expanding those aliases.
;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
;; is where to reenable the alias (expressed as number of chars
;; counting from END1).
(disabled-aliases nil))
(re-search-forward "^[^ \t]" end 'move)
(beginning-of-line)
(skip-chars-backward " \t\n")
(setq end1 (point-marker))
(goto-char beg1)
(while (< (point) end1)
(setq pos (point))
;; Reenable any aliases which were disabled for ranges
;; that we have passed out of.
(while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
(setq disabled-aliases (cdr disabled-aliases)))
;; EPOS gets position of end of next name;
;; SEPLEN gets length of whitespace&separator that follows it.
(if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
(setq epos (match-beginning 0)
seplen (- (point) epos))
(setq epos (marker-position end1) seplen 0))
(let (translation
(string (buffer-substring pos epos)))
(if (and (not (assoc string disabled-aliases))
(setq translation
(cdr (assoc string mail-aliases))))
(progn
;; This name is an alias. Disable it.
(setq disabled-aliases (cons (cons string (- end1 epos))
disabled-aliases))
;; Replace the alias with its expansion
;; then rescan the expansion for more aliases.
(goto-char pos)
(insert translation)
(delete-region (point) (+ (point) (- epos pos)))
(goto-char pos))
;; Name is not an alias. Skip to start of next name.
(goto-char epos)
(forward-char seplen))))
(set-marker end1 nil)))
(set-marker end nil)))
;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
(defun build-mail-aliases (&optional file)
"Read mail aliases from ~/.mailrc and set mail-aliases."
(setq file (expand-file-name (or file "~/.mailrc")))
(let ((buffer nil)
(obuf (current-buffer)))
(unwind-protect
(progn
(setq buffer (generate-new-buffer "mailrc"))
(buffer-flush-undo buffer)
(set-buffer buffer)
(cond ((get-file-buffer file)
(insert (save-excursion
(set-buffer (get-file-buffer file))
(buffer-substring (point-min) (point-max)))))
((not (file-exists-p file)))
(t (insert-file-contents file)))
;; Don't lose if no final newline.
(goto-char (point-max))
(or (eq (preceding-char) ?\n) (newline))
(goto-char (point-min))
;; handle "\\\n" continuation lines
(while (not (eobp))
(end-of-line)
(if (= (preceding-char) ?\\)
(progn (delete-char -1) (delete-char 1) (insert ?\ ))
(forward-char 1)))
(goto-char (point-min))
(while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
(re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
(re-search-forward "[^ \t]+")
(let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
(start (progn (skip-chars-forward " \t") (point))))
(end-of-line)
(define-mail-alias
name
(buffer-substring start (point)))))
mail-aliases)
(if buffer (kill-buffer buffer))
(set-buffer obuf))))
;; Always autoloadable in case the user wants to define aliases
;; interactively or in .emacs.
(defun define-mail-alias (name definition)
"Define NAME as a mail-alias that translates to DEFINITION."
(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
;; Read the defaults first, if we have not done so.
(if (eq mail-aliases t)
(progn
(setq mail-aliases nil)
(if (file-exists-p "~/.mailrc")
(build-mail-aliases))))
(let (tem)
;; ~/.mailrc contains addresses separated by spaces.
;; mailers should expect addresses separated by commas.
(while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
(if (= (match-end 0) (length definition))
(setq definition (substring definition 0 (1+ tem)))
(setq definition (concat (substring definition
0 (1+ tem))
", "
(substring definition (match-end 0))))
(setq tem (+ 3 tem))))
(setq tem (assoc name mail-aliases))
(if tem
(rplacd tem definition)
(setq mail-aliases (cons (cons name definition) mail-aliases)))))
|
