![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to mailalias.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: ;; Called from sendmail-send-it, or similar functions,
23: ;; only if some mail aliases are defined.
24: (defun expand-mail-aliases (beg end)
25: "Expand all mail aliases in suitable header fields found between BEG and END.
26: Suitable header fields are To, Cc and Bcc."
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: (delete-region (point) (+ (point) (- epos pos)))
74: (goto-char pos))
75: ;; Name is not an alias. Skip to start of next name.
76: (goto-char epos)
77: (forward-char seplen))))
78: (set-marker end1 nil)))
79: (set-marker end nil)))
80:
81: ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
82: (defun build-mail-aliases (&optional file)
83: "Read mail aliases from ~/.mailrc and set mail-aliases."
84: (setq file (expand-file-name (or file "~/.mailrc")))
85: (let ((buffer nil)
86: (obuf (current-buffer)))
87: (unwind-protect
88: (progn
89: (setq buffer (generate-new-buffer "mailrc"))
90: (buffer-flush-undo buffer)
91: (set-buffer buffer)
92: (cond ((get-file-buffer file)
93: (insert (save-excursion
94: (set-buffer (get-file-buffer file))
95: (buffer-substring (point-min) (point-max)))))
96: ((not (file-exists-p file)))
97: (t (insert-file-contents file)))
98: ;; Don't lose if no final newline.
99: (goto-char (point-max))
100: (or (eq (preceding-char) ?\n) (newline))
101: (goto-char (point-min))
102: ;; handle "\\\n" continuation lines
103: (while (not (eobp))
104: (end-of-line)
105: (if (= (preceding-char) ?\\)
106: (progn (delete-char -1) (delete-char 1) (insert ?\ ))
107: (forward-char 1)))
108: (goto-char (point-min))
109: (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
110: (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
111: (re-search-forward "[^ \t]+")
112: (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
113: (start (progn (skip-chars-forward " \t") (point))))
114: (end-of-line)
115: (define-mail-alias
116: name
117: (buffer-substring start (point)))))
118: mail-aliases)
119: (if buffer (kill-buffer buffer))
120: (set-buffer obuf))))
121:
122: ;; Always autoloadable in case the user wants to define aliases
123: ;; interactively or in .emacs.
124: (defun define-mail-alias (name definition)
125: "Define NAME as a mail-alias that translates to DEFINITION."
126: (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
127: ;; Read the defaults first, if we have not done so.
128: (if (eq mail-aliases t)
129: (progn
130: (setq mail-aliases nil)
131: (if (file-exists-p "~/.mailrc")
132: (build-mail-aliases))))
133: (let (tem)
134: ;; ~/.mailrc contains addresses separated by spaces.
135: ;; mailers should expect addresses separated by commas.
136: (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
137: (if (= (match-end 0) (length definition))
138: (setq definition (substring definition 0 (1+ tem)))
139: (setq definition (concat (substring definition
140: 0 (1+ tem))
141: ", "
142: (substring definition (match-end 0))))
143: (setq tem (+ 3 tem))))
144: (setq tem (assoc name mail-aliases))
145: (if tem
146: (rplacd tem definition)
147: (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.