Return to mailalias.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/mailalias.el, revision 1.1

1.1     ! root        1: ;; Expand mailing address aliases defined in ~/.mailrc.
        !             2: ;; Copyright (C) 1985 Richard M. Stallman.
        !             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:   (goto-char beg)
        !            28:   (setq end (set-marker (make-marker) end))
        !            29:   (let ((case-fold-search t))
        !            30:     (while (progn (setq case-fold-search t)
        !            31:                  (re-search-forward "^\\(to\\|cc\\|bcc\\):" end t))
        !            32:       (setq case-fold-search nil)
        !            33:       (skip-chars-forward " \t")
        !            34:       (let ((beg1 (point))
        !            35:            end1 pos epos seplen translation)
        !            36:        (re-search-forward "^[^ \t]" end 'move)
        !            37:        (beginning-of-line)
        !            38:        (skip-chars-backward " \t\n")
        !            39:        (setq end1 (point-marker))
        !            40:        (goto-char beg1)
        !            41:        (while (< (point) end1)
        !            42:          (setq pos (point))
        !            43:          (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
        !            44:              (setq epos (match-beginning 0)
        !            45:                    seplen (- (point) epos))
        !            46:            (setq epos end1 seplen 0))
        !            47:          (setq translation
        !            48:                (cdr (assoc (buffer-substring pos epos) mail-aliases)))
        !            49:          (if translation
        !            50:              (progn
        !            51:                (delete-region pos epos)
        !            52:                (goto-char pos)
        !            53:                (insert translation))
        !            54:            (goto-char epos)
        !            55:            (forward-char seplen)))
        !            56:        (set-marker end1 nil)))
        !            57:     (set-marker end nil)))
        !            58: 
        !            59: ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
        !            60: (defun build-mail-aliases ()
        !            61:   "Read mail aliases from ~/.mailrc and set mail-aliases."
        !            62:   (let (buffer exists name (file "~/.mailrc"))
        !            63:     (setq exists (get-file-buffer file))
        !            64:     (setq buffer (find-file-noselect file))
        !            65:     (unwind-protect
        !            66:        (save-excursion
        !            67:          (set-buffer buffer)
        !            68:          (goto-char (point-min))
        !            69:          (while (re-search-forward "^alias[ \t]*\\|^a[ \t]*" nil t)
        !            70:            (re-search-forward "[^ \t]+")
        !            71:            (setq name (buffer-substring (match-beginning 0) (match-end 0)))
        !            72:            (skip-chars-forward " \t")
        !            73:            (define-mail-alias
        !            74:             name
        !            75:             (buffer-substring (point) (progn (end-of-line) (point))))))
        !            76:       (or exists (kill-buffer buffer)))))
        !            77: 
        !            78: ;; Always autoloadable in case the user wants to define aliases
        !            79: ;; interactively or in .emacs.
        !            80: (defun define-mail-alias (name definition)
        !            81:   "Define NAME as a mail-alias that translates to DEFINITION."
        !            82:   (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
        !            83:   (let ((aelt (assoc name mail-aliases)))
        !            84:     (if aelt
        !            85:        (rplacd aelt definition)
        !            86:       (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.