![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mailalias.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to mailalias.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 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)
24: "Expand all mail aliases in suitable header fields found between BEG and END.
25: Suitable header fields are To, Cc and Bcc."
26: (if (eq mail-aliases t)
27: (progn (setq mail-aliases nil) (build-mail-aliases)))
28: (goto-char beg)
29: (setq end (set-marker (make-marker) end))
30: (let ((case-fold-search nil))
31: (while (let ((case-fold-search t))
32: (re-search-forward "^\\(to\\|cc\\|bcc\\):" end t))
33: (skip-chars-forward " \t")
34: (let ((beg1 (point))
35: end1 pos epos seplen
36: ;; DISABLED-ALIASES records aliases temporarily disabled
37: ;; while we scan text that resulted from expanding those aliases.
38: ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
39: ;; is where to reenable the alias (expressed as number of chars
40: ;; counting from END1).
41: (disabled-aliases nil))
42: (re-search-forward "^[^ \t]" end 'move)
43: (beginning-of-line)
44: (skip-chars-backward " \t\n")
45: (setq end1 (point-marker))
46: (goto-char beg1)
47: (while (< (point) end1)
48: (setq pos (point))
49: ;; Reenable any aliases which were disabled for ranges
50: ;; that we have passed out of.
51: (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
52: (setq disabled-aliases (cdr disabled-aliases)))
53: ;; EPOS gets position of end of next name;
54: ;; SEPLEN gets length of whitespace&separator that follows it.
55: (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
56: (setq epos (match-beginning 0)
57: seplen (- (point) epos))
58: (setq epos (marker-position end1) seplen 0))
59: (let (translation
60: (string (buffer-substring pos epos)))
61: (if (and (not (assoc string disabled-aliases))
62: (setq translation
63: (cdr (assoc string mail-aliases))))
64: (progn
65: ;; This name is an alias. Disable it.
66: (setq disabled-aliases (cons (cons string (- end1 epos))
67: disabled-aliases))
68: ;; Replace the alias with its expansion
69: ;; then rescan the expansion for more aliases.
70: (goto-char pos)
71: (insert translation)
72: (delete-region (point) (+ (point) (- epos pos)))
73: (goto-char pos))
74: ;; Name is not an alias. Skip to start of next name.
75: (goto-char epos)
76: (forward-char seplen))))
77: (set-marker end1 nil)))
78: (set-marker end nil)))
79:
80: ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
81: (defun build-mail-aliases (&optional file)
82: "Read mail aliases from ~/.mailrc and set mail-aliases."
83: (setq file (expand-file-name (or file "~/.mailrc")))
84: (let ((buffer nil)
85: (obuf (current-buffer)))
86: (unwind-protect
87: (progn
88: (setq buffer (generate-new-buffer "mailrc"))
89: (buffer-flush-undo buffer)
90: (set-buffer buffer)
91: (cond ((get-file-buffer file)
92: (insert (save-excursion
93: (set-buffer (get-file-buffer file))
94: (buffer-substring (point-min) (point-max)))))
95: ((not (file-exists-p file)))
96: (t (insert-file-contents file)))
97: ;; Don't lose if no final newline.
98: (goto-char (point-max))
99: (or (eq (preceding-char) ?\n) (newline))
100: (goto-char (point-min))
101: ;; handle "\\\n" continuation lines
102: (while (not (eobp))
103: (end-of-line)
104: (if (= (preceding-char) ?\\)
105: (progn (delete-char -1) (delete-char 1) (insert ?\ ))
106: (forward-char 1)))
107: (goto-char (point-min))
108: (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
109: (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
110: (re-search-forward "[^ \t]+")
111: (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
112: (start (progn (skip-chars-forward " \t") (point))))
113: (end-of-line)
114: (define-mail-alias
115: name
116: (buffer-substring start (point)))))
117: mail-aliases)
118: (if buffer (kill-buffer buffer))
119: (set-buffer obuf))))
120:
121: ;; Always autoloadable in case the user wants to define aliases
122: ;; interactively or in .emacs.
123: (defun define-mail-alias (name definition)
124: "Define NAME as a mail-alias that translates to DEFINITION."
125: (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
126: ;; Read the defaults first, if we have not done so.
127: (if (eq mail-aliases t)
128: (progn
129: (setq mail-aliases nil)
130: (if (file-exists-p "~/.mailrc")
131: (build-mail-aliases))))
132: (let (tem)
133: ;; ~/.mailrc contains addresses separated by spaces.
134: ;; mailers should expect addresses separated by commas.
135: (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
136: (if (= (match-end 0) (length definition))
137: (setq definition (substring definition 0 (1+ tem)))
138: (setq definition (concat (substring definition
139: 0 (1+ tem))
140: ", "
141: (substring definition (match-end 0))))
142: (setq tem (+ 3 tem))))
143: (setq tem (assoc name mail-aliases))
144: (if tem
145: (rplacd tem definition)
146: (setq mail-aliases (cons (cons name definition) mail-aliases)))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.