home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / r / rm-reply.zip / RM-REPLY.EL < prev   
Lisp/Scheme  |  1993-03-25  |  4KB  |  104 lines
  1. ;;  rmail-reply-cc.el
  2. ;;  automatically CC's the author of replies to GNU Emacs rmail messages.
  3. ;;
  4. ;;  written by Lee Short (short@asf.com)
  5. ;;  Copyright (C) 1992 Lee Short.
  6. ;;  last mod: 20 November, 1992
  7.  
  8. ;; LCD Archive Entry:
  9. ;; rmail-reply-cc|Lee Short|short@asf.com|
  10. ;; Automatically CC the author of replies to GNU Emacs rmail messages.|
  11. ;; 92-11-20||~/misc/rmail-reply-cc.el.Z|
  12.  
  13. ;; This is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation.  
  16.  
  17. ;; This software is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; For a copy of the GNU General Public License write to
  23. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25.  
  26. (defvar  my-mail-address "foo@bar.com" 
  27. "The users email address as it will be automaticlly inserted on CC: 
  28. lines.")
  29.  
  30. (defvar  auto-cc nil 
  31. "The value of this variable determines if the user will be automatically 
  32. CCed on mail messages.  If maillist.el is also used, then this
  33. variable is overridden by the three auto-cc-on-* variables found in 
  34. that file." )
  35.  
  36. (defun rmail-reply (just-sender)
  37.   "Reply to the current message.
  38. Normally include CC: to all other recipients of original message;
  39. prefix argument means ignore them.
  40. While composing the reply, use \\[mail-yank-original] to yank the
  41. original message into it."
  42.   (interactive "P")
  43.   ;;>> this gets set even if we abort. Can't do anything about it, though.
  44.   (rmail-set-attribute "answered" t)
  45.   (rmail-display-labels)
  46.   (let (from reply-to cc subject date to message-id resent-reply-to)
  47.     (save-excursion
  48.       (save-restriction
  49.     (widen)
  50.     (goto-char (rmail-msgbeg rmail-current-message))
  51.     (forward-line 1)
  52.     (if (= (following-char) ?0)
  53.         (narrow-to-region
  54.          (progn (forward-line 2)
  55.             (point))
  56.          (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
  57.                     'move)
  58.             (point)))
  59.       (narrow-to-region (point)
  60.                 (progn (search-forward "\n*** EOOH ***\n")
  61.                    (beginning-of-line) (point))))
  62.     (setq resent-reply-to (mail-fetch-field "resent-reply-to" t)
  63.           from (mail-fetch-field "from")
  64.           reply-to (or resent-reply-to
  65.                (mail-fetch-field "reply-to" nil t)
  66.                from)
  67.           cc (cond (just-sender nil)
  68.                (resent-reply-to (mail-fetch-field "resent-cc" t))
  69.                (t (mail-fetch-field "cc" nil t)))
  70.           subject (or (and resent-reply-to
  71.                    (mail-fetch-field "resent-subject" t))
  72.               (mail-fetch-field "subject"))
  73.           date (cond (resent-reply-to
  74.               (mail-fetch-field "resent-date" t))
  75.              ((mail-fetch-field "date")))
  76.           to (cond (resent-reply-to
  77.             (mail-fetch-field "resent-to" t))
  78.                ((mail-fetch-field "to" nil t))
  79.                ;((mail-fetch-field "apparently-to")) ack gag barf
  80.                (t ""))
  81.           message-id (cond (resent-reply-to
  82.                 (mail-fetch-field "resent-message-id" t))
  83.                    ((mail-fetch-field "message-id"))))))
  84.     (and subject
  85.      (string-match "\\`Re: " subject)
  86.      (setq subject (substring subject 4)))
  87.     (mail-other-window nil
  88.       (mail-strip-quoted-names reply-to)
  89.       subject
  90.       (rmail-make-in-reply-to-field from date message-id)
  91.       (let  ((cc-string
  92.           (if just-sender
  93.           nil
  94.                 (let* ((cc-list (rmail-dont-reply-to
  95.                           (mail-strip-quoted-names
  96.                           (if (null cc) to (concat to ", " cc))))))
  97.              (if (string= cc-list "") nil cc-list)))))
  98.          (if  (null cc-string)
  99.               (if auto-cc my-mail-address nil)
  100.               (if auto-cc
  101.                   (concat cc-string ", " my-mail-address)
  102.                   cc-string)))
  103.       (current-buffer))))
  104.