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