summaryrefslogtreecommitdiff
path: root/lisp/mail/mailalias.el
diff options
context:
space:
mode:
authorJoseph Arceneaux <jla@gnu.org>1990-03-06 16:45:37 +0000
committerJoseph Arceneaux <jla@gnu.org>1990-03-06 16:45:37 +0000
commit04db34be0e654d24269af1c93ffe37c970847ef0 (patch)
treeda17120aa6c55644455f15f7abe2c41f6738aace /lisp/mail/mailalias.el
parentb9d24ad76cc9b24fb36f4d889133177915ec808e (diff)
downloademacs-04db34be0e654d24269af1c93ffe37c970847ef0.tar.gz
Initial revision
Diffstat (limited to 'lisp/mail/mailalias.el')
-rw-r--r--lisp/mail/mailalias.el157
1 files changed, 157 insertions, 0 deletions
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
new file mode 100644
index 00000000000..7fc41289a15
--- /dev/null
+++ b/lisp/mail/mailalias.el
@@ -0,0 +1,157 @@
+;; 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 &optional exclude)
+ "Expand all mail aliases in suitable header fields found between BEG and END.
+Suitable header fields are To, Cc and Bcc. Optional 2nd arg EXCLUDE may be a
+regular expression defining text to be removed from alias expansions."
+ (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)
+ (if exclude
+ (let ((regexp
+ (concat "\\b\\(" exclude "\\)\\b"))
+ (end (point-marker)))
+ (goto-char pos)
+ (while (re-search-forward regexp end t)
+ (replace-match ""))
+ (goto-char end)))
+ (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-disable-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.
+This means that sending a message to NAME will actually send to DEFINITION.
+DEFINITION can be one or more mail addresses separated by commas."
+ (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)))))