[bpt/emacs.git] / lisp / mail / mailalias.el

;;; mailalias.el --- expand mailing address aliases defined in ~/.mailrc.

;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: mail

;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Basic functions for defining and expanding mail aliases.
;; These seal off the interface to the alias-definition parts of a
;; .mailrc file formatted for BSD's Mail or USL's mailx.

;;; Code:

(require 'sendmail)

;; 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', `From', `CC' and `BCC', `Reply-to', and
their `Resent-' variants.

Optional second arg EXCLUDE may be a regular expression defining text to be
removed from alias expansions."
  (sendmail-sync-aliases)
  (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 "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" 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-no-properties 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 the file specified
;; by mail-personal-alias-file (usually `~/.mailrc') exists.
(defun build-mail-aliases (&optional file)
  "Read mail aliases from personal aliases file and set `mail-aliases'.
By default, this is the file specified by `mail-personal-alias-file'."
  (setq file (expand-file-name (or file mail-personal-alias-file)))
  (let ((buffer nil)
	(obuf (current-buffer)))
    (unwind-protect
	(progn
	  (setq buffer (generate-new-buffer "mailrc"))
	  (buffer-disable-undo buffer)
	  (set-buffer buffer)
	  (while file
	    (cond ((get-file-buffer file)
		   (insert (save-excursion
			     (set-buffer (get-file-buffer file))
			     (buffer-substring-no-properties
			      (point-min) (point-max)))))
		  ((file-exists-p file) (insert-file-contents file))
		  ((file-exists-p (setq file (concat "~/" file)))
		   (insert-file-contents file))
		  (t (setq file nil)))
	    ;; 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))
	    ;; handle `source' directives -- Eddy/1994/May/25
	    (cond ((re-search-forward "^source[ \t]+" nil t)
		   (re-search-forward "\\S-+")
		   (setq file (buffer-substring-no-properties
			       (match-beginning 0) (match-end 0)))
		   (beginning-of-line)
		   (insert "# ") ; to ensure we don't re-process this file
		   (beginning-of-line))
		  (t (setq file nil))))
	  (goto-char (point-min))
	  (while (re-search-forward
		  "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t]+\\)" nil t)
	    (let* ((name (match-string 2))
		   (start (progn (skip-chars-forward " \t") (point))))
	      (end-of-line)
	      (define-mail-alias
		name
		(buffer-substring-no-properties start (point))
		t)))
	  mail-aliases)
      (if buffer (kill-buffer buffer))
      (set-buffer obuf))))

;; Always autoloadable in case the user wants to define aliases
;; interactively or in .emacs.
;;;###autoload
(defun define-mail-alias (name definition &optional from-mailrc-file)
  "Define NAME as a mail alias that translates to DEFINITION.
This means that sending a message to NAME will actually send to DEFINITION.

Normally, the addresses in DEFINITION must be separated by commas.
If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION 
can be separated by spaces; an address can contain spaces
if it is quoted with double-quotes."

  (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
  ;; Read the defaults first, if we have not done so.
  (sendmail-sync-aliases)
  (if (eq mail-aliases t)
      (progn
	(setq mail-aliases nil)
	(if (file-exists-p mail-personal-alias-file)
	    (build-mail-aliases))))
  ;; strip garbage from front and end
  (if (string-match "\\`[ \t\n,]+" definition)
      (setq definition (substring definition (match-end 0))))
  (if (string-match "[ \t\n,]+\\'" definition)
      (setq definition (substring definition 0 (match-beginning 0))))
  (let ((result '())
	;; If DEFINITION is null string, avoid looping even once.
	(start (and (not (equal definition "")) 0))
	(L (length definition))
	end tem)
    (while start
      ;; If we're reading from the mailrc file, then addresses are delimited
      ;; by spaces, and addresses with embedded spaces must be surrounded by
      ;; double-quotes.  Otherwise, addresses are separated by commas.
      (if from-mailrc-file
	  (if (eq ?\" (aref definition start))
	      (setq start (1+ start)
		    end (string-match "\"[ \t,]*" definition start))
	    (setq end (string-match "[ \t,]+" definition start)))
	(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
      (setq result (cons (substring definition start end) result))
      (setq start (and end
		       (/= (match-end 0) L)
		       (match-end 0))))
    (setq definition (mapconcat (function identity)
				(nreverse result)
				", "))
    (setq tem (assoc name mail-aliases))
    (if tem
	(rplacd tem definition)
      (setq mail-aliases (cons (cons name definition) mail-aliases)))))

(provide 'mailalias)

;;; mailalias.el ends here
Commit	Line	Data
6594deb0 ER	1	;;; mailalias.el --- expand mailing address aliases defined in ~/.mailrc.
6594deb0 ER	2
3a801d0c ER	3	;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
3a801d0c ER	4
e5167999	5	;; Maintainer: FSF
fd7fa35a	6	;; Keywords: mail
e5167999	7
80a677d9 JA	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
e5167999	12	;; the Free Software Foundation; either version 2, or (at your option)
80a677d9 JA	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
b578f267 EN	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
80a677d9	24
e41b2db1 ER	25	;;; Commentary:
	26
	27	;; Basic functions for defining and expanding mail aliases.
	28	;; These seal off the interface to the alias-definition parts of a
	29	;; .mailrc file formatted for BSD's Mail or USL's mailx.
	30
e5167999	31	;;; Code:
80a677d9	32
594906dd	33	(require 'sendmail)
c2db7f31	34
80a677d9 JA	35	;; Called from sendmail-send-it, or similar functions,
	36	;; only if some mail aliases are defined.
	37	(defun expand-mail-aliases (beg end &optional exclude)
	38	"Expand all mail aliases in suitable header fields found between BEG and END.
1abe8488 KH	39	Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and
	40	their `Resent-' variants.
	41
96846422 RS	42	Optional second arg EXCLUDE may be a regular expression defining text to be
96846422 RS	43	removed from alias expansions."
e934d700	44	(sendmail-sync-aliases)
80a677d9 JA	45	(if (eq mail-aliases t)
	46	(progn (setq mail-aliases nil) (build-mail-aliases)))
	47	(goto-char beg)
	48	(setq end (set-marker (make-marker) end))
	49	(let ((case-fold-search nil))
	50	(while (let ((case-fold-search t))
1abe8488	51	(re-search-forward "^\\(Resent-\\)?\\(To\\\|From\\\|CC\\\|BCC\\\|Reply-to\\):" end t))
80a677d9 JA	52	(skip-chars-forward " \t")
	53	(let ((beg1 (point))
	54	end1 pos epos seplen
	55	;; DISABLED-ALIASES records aliases temporarily disabled
	56	;; while we scan text that resulted from expanding those aliases.
	57	;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
	58	;; is where to reenable the alias (expressed as number of chars
	59	;; counting from END1).
	60	(disabled-aliases nil))
	61	(re-search-forward "^[^ \t]" end 'move)
	62	(beginning-of-line)
	63	(skip-chars-backward " \t\n")
	64	(setq end1 (point-marker))
	65	(goto-char beg1)
	66	(while (< (point) end1)
	67	(setq pos (point))
	68	;; Reenable any aliases which were disabled for ranges
	69	;; that we have passed out of.
	70	(while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
	71	(setq disabled-aliases (cdr disabled-aliases)))
	72	;; EPOS gets position of end of next name;
	73	;; SEPLEN gets length of whitespace&separator that follows it.
	74	(if (re-search-forward "[ \t][\n,][ \t]" end1 t)
	75	(setq epos (match-beginning 0)
	76	seplen (- (point) epos))
	77	(setq epos (marker-position end1) seplen 0))
	78	(let (translation
2bc9b0c7	79	(string (buffer-substring-no-properties pos epos)))
80a677d9 JA	80	(if (and (not (assoc string disabled-aliases))
	81	(setq translation
	82	(cdr (assoc string mail-aliases))))
	83	(progn
	84	;; This name is an alias. Disable it.
	85	(setq disabled-aliases (cons (cons string (- end1 epos))
	86	disabled-aliases))
	87	;; Replace the alias with its expansion
	88	;; then rescan the expansion for more aliases.
	89	(goto-char pos)
	90	(insert translation)
	91	(if exclude
	92	(let ((regexp
	93	(concat "\\b\\(" exclude "\\)\\b"))
	94	(end (point-marker)))
	95	(goto-char pos)
	96	(while (re-search-forward regexp end t)
	97	(replace-match ""))
	98	(goto-char end)))
	99	(delete-region (point) (+ (point) (- epos pos)))
	100	(goto-char pos))
	101	;; Name is not an alias. Skip to start of next name.
	102	(goto-char epos)
	103	(forward-char seplen))))
	104	(set-marker end1 nil)))
	105	(set-marker end nil)))
	106
9d73ab0d NF	107	;; Called by mail-setup, or similar functions, only if the file specified
9d73ab0d NF	108	;; by mail-personal-alias-file (usually `~/.mailrc') exists.
80a677d9	109	(defun build-mail-aliases (&optional file)
9d73ab0d NF	110	"Read mail aliases from personal aliases file and set `mail-aliases'.
	111	By default, this is the file specified by `mail-personal-alias-file'."
	112	(setq file (expand-file-name (or file mail-personal-alias-file)))
80a677d9 JA	113	(let ((buffer nil)
	114	(obuf (current-buffer)))
	115	(unwind-protect
	116	(progn
	117	(setq buffer (generate-new-buffer "mailrc"))
	118	(buffer-disable-undo buffer)
	119	(set-buffer buffer)
3c55fda0 RS	120	(while file
	121	(cond ((get-file-buffer file)
	122	(insert (save-excursion
	123	(set-buffer (get-file-buffer file))
599d82c8 RS	124	(buffer-substring-no-properties
599d82c8 RS	125	(point-min) (point-max)))))
3c55fda0 RS	126	((file-exists-p file) (insert-file-contents file))
	127	((file-exists-p (setq file (concat "~/" file)))
	128	(insert-file-contents file))
	129	(t (setq file nil)))
	130	;; Don't lose if no final newline.
	131	(goto-char (point-max))
	132	(or (eq (preceding-char) ?\n) (newline))
	133	(goto-char (point-min))
	134	;; handle "\\\n" continuation lines
	135	(while (not (eobp))
	136	(end-of-line)
	137	(if (= (preceding-char) ?\\)
	138	(progn (delete-char -1) (delete-char 1) (insert ?\ ))
80a677d9	139	(forward-char 1)))
3c55fda0 RS	140	(goto-char (point-min))
	141	;; handle `source' directives -- Eddy/1994/May/25
	142	(cond ((re-search-forward "^source[ \t]+" nil t)
	143	(re-search-forward "\\S-+")
599d82c8 RS	144	(setq file (buffer-substring-no-properties
599d82c8 RS	145	(match-beginning 0) (match-end 0)))
3c55fda0 RS	146	(beginning-of-line)
	147	(insert "# ") ; to ensure we don't re-process this file
	148	(beginning-of-line))
	149	(t (setq file nil))))
80a677d9	150	(goto-char (point-min))
d9817d8c FP	151	(while (re-search-forward
	152	"^\\(a\\\|alias\\\|g\\\|group\\)[ \t]+\\([^ \t]+\\)" nil t)
	153	(let* ((name (match-string 2))
80a677d9 JA	154	(start (progn (skip-chars-forward " \t") (point))))
	155	(end-of-line)
	156	(define-mail-alias
	157	name
599d82c8	158	(buffer-substring-no-properties start (point))
37e379dd	159	t)))
80a677d9 JA	160	mail-aliases)
	161	(if buffer (kill-buffer buffer))
	162	(set-buffer obuf))))
	163
	164	;; Always autoloadable in case the user wants to define aliases
	165	;; interactively or in .emacs.
7229064d	166	;;;###autoload
37e379dd	167	(defun define-mail-alias (name definition &optional from-mailrc-file)
96846422	168	"Define NAME as a mail alias that translates to DEFINITION.
80a677d9	169	This means that sending a message to NAME will actually send to DEFINITION.
fa786521 RS	170
	171	Normally, the addresses in DEFINITION must be separated by commas.
	172	If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION
	173	can be separated by spaces; an address can contain spaces
	174	if it is quoted with double-quotes."
	175
80a677d9 JA	176	(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
80a677d9 JA	177	;; Read the defaults first, if we have not done so.
e934d700	178	(sendmail-sync-aliases)
80a677d9 JA	179	(if (eq mail-aliases t)
	180	(progn
	181	(setq mail-aliases nil)
9d73ab0d	182	(if (file-exists-p mail-personal-alias-file)
80a677d9	183	(build-mail-aliases))))
3af1a1f3 RS	184	;; strip garbage from front and end
3af1a1f3 RS	185	(if (string-match "\\`[ \t\n,]+" definition)
aa228418	186	(setq definition (substring definition (match-end 0))))
3af1a1f3	187	(if (string-match "[ \t\n,]+\\'" definition)
aa228418	188	(setq definition (substring definition 0 (match-beginning 0))))
37e379dd	189	(let ((result '())
cc4b6c02 RS	190	;; If DEFINITION is null string, avoid looping even once.
cc4b6c02 RS	191	(start (and (not (equal definition "")) 0))
37e379dd RS	192	(L (length definition))
	193	end tem)
	194	(while start
	195	;; If we're reading from the mailrc file, then addresses are delimited
	196	;; by spaces, and addresses with embedded spaces must be surrounded by
	197	;; double-quotes. Otherwise, addresses are separated by commas.
	198	(if from-mailrc-file
	199	(if (eq ?\" (aref definition start))
	200	(setq start (1+ start)
	201	end (string-match "\"[ \t,]*" definition start))
cc4b6c02 RS	202	(setq end (string-match "[ \t,]+" definition start)))
cc4b6c02 RS	203	(setq end (string-match "[ \t\n,],[ \t\n,]" definition start)))
37e379dd RS	204	(setq result (cons (substring definition start end) result))
	205	(setq start (and end
	206	(/= (match-end 0) L)
	207	(match-end 0))))
	208	(setq definition (mapconcat (function identity)
	209	(nreverse result)
	210	", "))
80a677d9 JA	211	(setq tem (assoc name mail-aliases))
	212	(if tem
	213	(rplacd tem definition)
	214	(setq mail-aliases (cons (cons name definition) mail-aliases)))))
6594deb0	215
e8a57935 JB	216	(provide 'mailalias)
e8a57935 JB	217
6594deb0	218	;;; mailalias.el ends here