diff options
author | Joseph Arceneaux <jla@gnu.org> | 1990-03-06 16:45:37 +0000 |
---|---|---|
committer | Joseph Arceneaux <jla@gnu.org> | 1990-03-06 16:45:37 +0000 |
commit | 04db34be0e654d24269af1c93ffe37c970847ef0 (patch) | |
tree | da17120aa6c55644455f15f7abe2c41f6738aace /lisp/mail/mailalias.el | |
parent | b9d24ad76cc9b24fb36f4d889133177915ec808e (diff) | |
download | emacs-04db34be0e654d24269af1c93ffe37c970847ef0.tar.gz |
Initial revision
Diffstat (limited to 'lisp/mail/mailalias.el')
-rw-r--r-- | lisp/mail/mailalias.el | 157 |
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))))) |