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

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.