home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / mail-dofcc.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  3.9 KB  |  106 lines
  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!swrinde!ucsd!ucbvax!compass.com!worley Tue Apr 10 21:49:59 EDT 1990
  2. ;Article 1735 of comp.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!swrinde!ucsd!ucbvax!compass.com!worley
  4. ;>From: worley@compass.com (Dale Worley)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: FCC in RMAIL
  7. ;Message-ID: <9004091559.AA17541@sn1987a.compass.com>
  8. ;Date: 9 Apr 90 15:59:11 GMT
  9. ;Sender: daemon@ucbvax.BERKELEY.EDU
  10. ;Lines: 92
  11. ;
  12. ;Someone named Robert writes:
  13. ;> I'm curious, the FCC (save a copy of message to a file) field seems to
  14. ;> do The Wrong Thing in sendmail.  In particular, it seems to assume
  15. ;> that the file that it's carbon-copying to is a UNIX mail file, rather
  16. ;> than a Babyl file, so if you try to save to a babyl file, it creates
  17. ;> garble.  Does anyone have a patch for this (that checks for babyl
  18. ;> file, and if so, formats the message properly)?
  19. ;
  20. ;The problem only arises if the file is already in a buffer, because
  21. ;Rmail will convert Unix-style messages appended to an Rmail file into
  22. ;Rmail format upon input.  (Make sure that you have applied the patch
  23. ;to rmail-output-to-rmail-file I posted previously, because otherwise
  24. ;the Rmail 'o' command doesn't reformat Unix-style messages.)  The
  25. ;following version of mail-do-fcc handles Rmail files in buffers
  26. ;correctly:
  27.  
  28. (defun mail-do-fcc (header-end)
  29.   (let (fcc-list
  30.     (rmailbuf (current-buffer))
  31.     (tembuf (generate-new-buffer " rmail output"))
  32.     (case-fold-search t))
  33.     (save-excursion
  34.       (goto-char (point-min))
  35.       (while (re-search-forward "^FCC:[ \t]*" header-end t)
  36.     (setq fcc-list (cons (buffer-substring (point)
  37.                            (progn
  38.                          (end-of-line)
  39.                          (skip-chars-backward " \t")
  40.                          (point)))
  41.                  fcc-list))
  42.     (delete-region (match-beginning 0)
  43.                (progn (forward-line 1) (point))))
  44.       (set-buffer tembuf)
  45.       (erase-buffer)
  46.       (insert "\nFrom " (user-login-name) " "
  47.           (current-time-string) "\n")
  48.       (insert-buffer-substring rmailbuf)
  49.       ;; Make sure messages are separated.
  50.       (goto-char (point-max))
  51.       (insert ?\n)
  52.       (goto-char 2)
  53.       ;; ``Quote'' "^From " as ">From "
  54.       ;;  (note that this isn't really quoting, as there is no requirement
  55.       ;;   that "^[>]+From " be quoted in the same transparent way.)
  56.       (let ((case-fold-search nil))
  57.     (while (search-forward "\nFrom " nil t)
  58.       (forward-char -5)
  59.       (insert ?>)))
  60.       (while fcc-list
  61.     (let ((buffer (get-file-buffer (car fcc-list))))
  62.       (if buffer
  63.           ;; File is present in a buffer => append to that buffer.
  64.           (let ((curbuf (current-buffer))
  65.             (beg (point-min)) (end (point-max)))
  66.         (save-excursion
  67.           (set-buffer buffer)
  68.           (if (eq major-mode 'rmail-mode)
  69.               ;; Append as a message to an RMAIL file
  70.               (let ((b (point-min))
  71.                 (e (point-max))
  72.                 (buffer-read-only nil))
  73.             (unwind-protect
  74.                 (progn
  75.                   (widen)
  76.                   (goto-char (point-max))
  77.                   ;; This forces RMAIL's message counters to be
  78.                   ;; recomputed when the next RMAIL operation is
  79.                   ;; done on the buffer.
  80.                   ;; See rmail-maybe-set-message-counters.
  81.                   (setq rmail-total-messages nil)
  82.                   (insert "\C-l\n0, unseen,,\n*** EOOH ***\nFrom: "
  83.                       (user-login-name)
  84.                       "\nDate: "
  85.                       (current-time-string)
  86.                       "\n")
  87.                   (insert-buffer-substring rmailbuf)
  88.                   (insert "\n\C-_"))
  89.               (narrow-to-region b e)))
  90.             ;; Append to an ordinary file as a Unix mail message
  91.             (goto-char (point-max))
  92.             (insert-buffer-substring curbuf beg end))))
  93.         ;; Else append to the file directly.
  94.         ;; (It's OK if it is an RMAIL file -- the message will be converted
  95.         ;; when the file is read in.)
  96.         (write-region (point-min) (point-max) (car fcc-list) t)))
  97.     (setq fcc-list (cdr fcc-list))))
  98.     (kill-buffer tembuf)))
  99.  
  100. ;Dale Worley        Compass, Inc.            worley@compass.com
  101. ;--
  102. ;Seen in a net discussion:  It took a lot of work for tofu to become
  103. ;politically correct.
  104.  
  105.  
  106.