[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, 675 Mass Ave, Cambridge, MA 02139, 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:

(defvar mail-aliases t
  "Alias of mail address aliases,
or t meaning should be initialized from `~/.mailrc'.")

;; 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' and their `Resent-' variants.
Optional second 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\\|resent-to\\|resent-cc\\|resent-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.
;;;###autoload
(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))))
  ;; Strip leading and trailing blanks.
  (if (string-match "^[ \t]+" definition)
      (setq definition (substring definition (match-end 0))))
  (if (string-match "[ \t]+$" definition)
      (setq definition (substring definition 0 (match-beginning 0))))
  (let ((first (aref definition 0))
	(last (aref definition (1- (length definition))))
	tem)
    (if (and (= first last) (memq first '(?\' ?\")))
	;; Strip quotation marks.
	(setq definition (substring definition 1 (1- (length definition))))
      ;; ~/.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)))))

(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
	21	;; along with GNU Emacs; see the file COPYING. If not, write to
	22	;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
	23
e41b2db1 ER	24	;;; Commentary:
	25
	26	;; Basic functions for defining and expanding mail aliases.
	27	;; These seal off the interface to the alias-definition parts of a
	28	;; .mailrc file formatted for BSD's Mail or USL's mailx.
	29
e5167999	30	;;; Code:
80a677d9	31
c2db7f31 RS	32	(defvar mail-aliases t
	33	"Alias of mail address aliases,
	34	or t meaning should be initialized from `~/.mailrc'.")
	35
80a677d9 JA	36	;; Called from sendmail-send-it, or similar functions,
	37	;; only if some mail aliases are defined.
	38	(defun expand-mail-aliases (beg end &optional exclude)
	39	"Expand all mail aliases in suitable header fields found between BEG and END.
96846422 RS	40	Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
	41	Optional second arg EXCLUDE may be a regular expression defining text to be
	42	removed from alias expansions."
80a677d9 JA	43	(if (eq mail-aliases t)
	44	(progn (setq mail-aliases nil) (build-mail-aliases)))
	45	(goto-char beg)
	46	(setq end (set-marker (make-marker) end))
	47	(let ((case-fold-search nil))
	48	(while (let ((case-fold-search t))
6f8c78e1	49	(re-search-forward "^\\(to\\\|cc\\\|bcc\\\|resent-to\\\|resent-cc\\\|resent-bcc\\):" end t))
80a677d9 JA	50	(skip-chars-forward " \t")
	51	(let ((beg1 (point))
	52	end1 pos epos seplen
	53	;; DISABLED-ALIASES records aliases temporarily disabled
	54	;; while we scan text that resulted from expanding those aliases.
	55	;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
	56	;; is where to reenable the alias (expressed as number of chars
	57	;; counting from END1).
	58	(disabled-aliases nil))
	59	(re-search-forward "^[^ \t]" end 'move)
	60	(beginning-of-line)
	61	(skip-chars-backward " \t\n")
	62	(setq end1 (point-marker))
	63	(goto-char beg1)
	64	(while (< (point) end1)
	65	(setq pos (point))
	66	;; Reenable any aliases which were disabled for ranges
	67	;; that we have passed out of.
	68	(while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
	69	(setq disabled-aliases (cdr disabled-aliases)))
	70	;; EPOS gets position of end of next name;
	71	;; SEPLEN gets length of whitespace&separator that follows it.
	72	(if (re-search-forward "[ \t][\n,][ \t]" end1 t)
	73	(setq epos (match-beginning 0)
	74	seplen (- (point) epos))
	75	(setq epos (marker-position end1) seplen 0))
	76	(let (translation
	77	(string (buffer-substring pos epos)))
	78	(if (and (not (assoc string disabled-aliases))
	79	(setq translation
	80	(cdr (assoc string mail-aliases))))
	81	(progn
	82	;; This name is an alias. Disable it.
	83	(setq disabled-aliases (cons (cons string (- end1 epos))
	84	disabled-aliases))
	85	;; Replace the alias with its expansion
	86	;; then rescan the expansion for more aliases.
	87	(goto-char pos)
	88	(insert translation)
	89	(if exclude
	90	(let ((regexp
	91	(concat "\\b\\(" exclude "\\)\\b"))
	92	(end (point-marker)))
	93	(goto-char pos)
	94	(while (re-search-forward regexp end t)
	95	(replace-match ""))
	96	(goto-char end)))
	97	(delete-region (point) (+ (point) (- epos pos)))
	98	(goto-char pos))
	99	;; Name is not an alias. Skip to start of next name.
	100	(goto-char epos)
	101	(forward-char seplen))))
	102	(set-marker end1 nil)))
	103	(set-marker end nil)))
	104
	105	;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
	106	(defun build-mail-aliases (&optional file)
1ddea2ab	107	"Read mail aliases from `~/.mailrc' and set `mail-aliases'."
80a677d9 JA	108	(setq file (expand-file-name (or file "~/.mailrc")))
	109	(let ((buffer nil)
	110	(obuf (current-buffer)))
	111	(unwind-protect
	112	(progn
	113	(setq buffer (generate-new-buffer "mailrc"))
	114	(buffer-disable-undo buffer)
	115	(set-buffer buffer)
	116	(cond ((get-file-buffer file)
	117	(insert (save-excursion
	118	(set-buffer (get-file-buffer file))
	119	(buffer-substring (point-min) (point-max)))))
	120	((not (file-exists-p file)))
	121	(t (insert-file-contents file)))
	122	;; Don't lose if no final newline.
	123	(goto-char (point-max))
	124	(or (eq (preceding-char) ?\n) (newline))
	125	(goto-char (point-min))
	126	;; handle "\\\n" continuation lines
	127	(while (not (eobp))
	128	(end-of-line)
	129	(if (= (preceding-char) ?\\)
	130	(progn (delete-char -1) (delete-char 1) (insert ?\ ))
	131	(forward-char 1)))
	132	(goto-char (point-min))
	133	(while (or (re-search-forward "^a\\(lias\\\|\\)[ \t]+" nil t)
	134	(re-search-forward "^g\\(roup\\\|\\)[ \t]+" nil t))
	135	(re-search-forward "[^ \t]+")
	136	(let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
	137	(start (progn (skip-chars-forward " \t") (point))))
	138	(end-of-line)
	139	(define-mail-alias
	140	name
	141	(buffer-substring start (point)))))
	142	mail-aliases)
	143	(if buffer (kill-buffer buffer))
	144	(set-buffer obuf))))
	145
	146	;; Always autoloadable in case the user wants to define aliases
	147	;; interactively or in .emacs.
7229064d	148	;;;###autoload
80a677d9	149	(defun define-mail-alias (name definition)
96846422	150	"Define NAME as a mail alias that translates to DEFINITION.
80a677d9 JA	151	This means that sending a message to NAME will actually send to DEFINITION.
	152	DEFINITION can be one or more mail addresses separated by commas."
	153	(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
	154	;; Read the defaults first, if we have not done so.
	155	(if (eq mail-aliases t)
	156	(progn
	157	(setq mail-aliases nil)
	158	(if (file-exists-p "~/.mailrc")
	159	(build-mail-aliases))))
aa228418 JB	160	;; Strip leading and trailing blanks.
	161	(if (string-match "^[ \t]+" definition)
	162	(setq definition (substring definition (match-end 0))))
	163	(if (string-match "[ \t]+$" definition)
	164	(setq definition (substring definition 0 (match-beginning 0))))
	165	(let ((first (aref definition 0))
	166	(last (aref definition (1- (length definition))))
	167	tem)
	168	(if (and (= first last) (memq first '(?\' ?\")))
	169	;; Strip quotation marks.
	170	(setq definition (substring definition 1 (1- (length definition))))
	171	;; ~/.mailrc contains addresses separated by spaces.
	172	;; mailers should expect addresses separated by commas.
	173	(while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
	174	(if (= (match-end 0) (length definition))
	175	(setq definition (substring definition 0 (1+ tem)))
	176	(setq definition (concat (substring definition
	177	0 (1+ tem))
	178	", "
	179	(substring definition (match-end 0))))
	180	(setq tem (+ 3 tem)))))
80a677d9 JA	181	(setq tem (assoc name mail-aliases))
	182	(if tem
	183	(rplacd tem definition)
	184	(setq mail-aliases (cons (cons name definition) mail-aliases)))))
6594deb0	185
e8a57935 JB	186	(provide 'mailalias)
e8a57935 JB	187
6594deb0	188	;;; mailalias.el ends here