![[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.