Return to mailalias.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

Annotation of GNUtools/emacs/lisp/mailalias.el, revision 1.1

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 free software; you can redistribute it and/or modify
        !             7: ;; it under the terms of the GNU General Public License as published by
        !             8: ;; the Free Software Foundation; either version 1, or (at your option)
        !             9: ;; any later version.
        !            10: 
        !            11: ;; GNU Emacs is distributed in the hope that it will be useful,
        !            12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: ;; GNU General Public License for more details.
        !            15: 
        !            16: ;; You should have received a copy of the GNU General Public License
        !            17: ;; along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
        !            19: 
        !            20: 
        !            21: ;; Called from sendmail-send-it, or similar functions,
        !            22: ;; only if some mail aliases are defined.
        !            23: (defun expand-mail-aliases (beg end)
        !            24:   "Expand all mail aliases in suitable header fields found between BEG and END.
        !            25: Suitable header fields are To, Cc and Bcc."
        !            26:   (if (eq mail-aliases t)
        !            27:       (progn (setq mail-aliases nil) (build-mail-aliases)))
        !            28:   (goto-char beg)
        !            29:   (setq end (set-marker (make-marker) end))
        !            30:   (let ((case-fold-search nil))
        !            31:     (while (let ((case-fold-search t))
        !            32:             (re-search-forward "^\\(to\\|cc\\|bcc\\):" end t))
        !            33:       (skip-chars-forward " \t")
        !            34:       (let ((beg1 (point))
        !            35:            end1 pos epos seplen
        !            36:            ;; DISABLED-ALIASES records aliases temporarily disabled
        !            37:            ;; while we scan text that resulted from expanding those aliases.
        !            38:            ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
        !            39:            ;; is where to reenable the alias (expressed as number of chars
        !            40:            ;; counting from END1).
        !            41:            (disabled-aliases nil))
        !            42:        (re-search-forward "^[^ \t]" end 'move)
        !            43:        (beginning-of-line)
        !            44:        (skip-chars-backward " \t\n")
        !            45:        (setq end1 (point-marker))
        !            46:        (goto-char beg1)
        !            47:        (while (< (point) end1)
        !            48:          (setq pos (point))
        !            49:          ;; Reenable any aliases which were disabled for ranges
        !            50:          ;; that we have passed out of.
        !            51:          (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
        !            52:            (setq disabled-aliases (cdr disabled-aliases)))
        !            53:          ;; EPOS gets position of end of next name;
        !            54:          ;; SEPLEN gets length of whitespace&separator that follows it.
        !            55:          (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
        !            56:              (setq epos (match-beginning 0)
        !            57:                    seplen (- (point) epos))
        !            58:            (setq epos (marker-position end1) seplen 0))
        !            59:          (let (translation
        !            60:                (string (buffer-substring pos epos)))
        !            61:            (if (and (not (assoc string disabled-aliases))
        !            62:                     (setq translation
        !            63:                           (cdr (assoc string mail-aliases))))
        !            64:                (progn
        !            65:                  ;; This name is an alias.  Disable it.
        !            66:                  (setq disabled-aliases (cons (cons string (- end1 epos))
        !            67:                                               disabled-aliases))
        !            68:                  ;; Replace the alias with its expansion
        !            69:                  ;; then rescan the expansion for more aliases.
        !            70:                  (goto-char pos)
        !            71:                  (insert translation)
        !            72:                  (delete-region (point) (+ (point) (- epos pos)))
        !            73:                  (goto-char pos))
        !            74:              ;; Name is not an alias.  Skip to start of next name.
        !            75:              (goto-char epos)
        !            76:              (forward-char seplen))))
        !            77:        (set-marker end1 nil)))
        !            78:     (set-marker end nil)))
        !            79: 
        !            80: ;; Called by mail-setup, or similar functions, only if ~/.mailrc exists.
        !            81: (defun build-mail-aliases (&optional file)
        !            82:   "Read mail aliases from ~/.mailrc and set mail-aliases."
        !            83:   (setq file (expand-file-name (or file "~/.mailrc")))
        !            84:   (let ((buffer nil)
        !            85:        (obuf (current-buffer)))
        !            86:     (unwind-protect
        !            87:        (progn
        !            88:          (setq buffer (generate-new-buffer "mailrc"))
        !            89:          (buffer-flush-undo buffer)
        !            90:          (set-buffer buffer)
        !            91:          (cond ((get-file-buffer file)
        !            92:                 (insert (save-excursion
        !            93:                           (set-buffer (get-file-buffer file))
        !            94:                           (buffer-substring (point-min) (point-max)))))
        !            95:                ((not (file-exists-p file)))
        !            96:                (t (insert-file-contents file)))
        !            97:          ;; Don't lose if no final newline.
        !            98:          (goto-char (point-max))
        !            99:          (or (eq (preceding-char) ?\n) (newline))
        !           100:          (goto-char (point-min))
        !           101:          ;; handle "\\\n" continuation lines
        !           102:          (while (not (eobp))
        !           103:            (end-of-line)
        !           104:            (if (= (preceding-char) ?\\)
        !           105:                (progn (delete-char -1) (delete-char 1) (insert ?\ ))
        !           106:                (forward-char 1)))
        !           107:          (goto-char (point-min))
        !           108:          (while (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
        !           109:                     (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
        !           110:            (re-search-forward "[^ \t]+")
        !           111:            (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
        !           112:                   (start (progn (skip-chars-forward " \t") (point))))
        !           113:              (end-of-line)
        !           114:              (define-mail-alias
        !           115:                name
        !           116:                (buffer-substring start (point)))))
        !           117:          mail-aliases)
        !           118:       (if buffer (kill-buffer buffer))
        !           119:       (set-buffer obuf))))
        !           120: 
        !           121: ;; Always autoloadable in case the user wants to define aliases
        !           122: ;; interactively or in .emacs.
        !           123: (defun define-mail-alias (name definition)
        !           124:   "Define NAME as a mail-alias that translates to DEFINITION."
        !           125:   (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
        !           126:   ;; Read the defaults first, if we have not done so.
        !           127:   (if (eq mail-aliases t)
        !           128:       (progn
        !           129:        (setq mail-aliases nil)
        !           130:        (if (file-exists-p "~/.mailrc")
        !           131:            (build-mail-aliases))))
        !           132:   (let (tem)
        !           133:     ;; ~/.mailrc contains addresses separated by spaces.
        !           134:     ;; mailers should expect addresses separated by commas.
        !           135:     (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
        !           136:       (if (= (match-end 0) (length definition))
        !           137:          (setq definition (substring definition 0 (1+ tem)))
        !           138:        (setq definition (concat (substring definition
        !           139:                                            0 (1+ tem))
        !           140:                                 ", "
        !           141:                                 (substring definition (match-end 0))))
        !           142:        (setq tem (+ 3 tem))))
        !           143:     (setq tem (assoc name mail-aliases))
        !           144:     (if tem
        !           145:        (rplacd tem definition)
        !           146:       (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.