home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / undigest.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  4KB  |  106 lines
  1. ;; "RMAIL" mail reader for Emacs.
  2. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  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. ;; note Interent RFP934
  22.  
  23. (defun undigestify-rmail-message ()
  24.   "Break up a digest message into its constituent messages.
  25. Leaves original message, deleted, before the undigestified messages."
  26.   (interactive)
  27.   (widen)
  28.   (let ((buffer-read-only nil)
  29.     (msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
  30.                       (rmail-msgend rmail-current-message))))
  31.     (goto-char (rmail-msgend rmail-current-message))
  32.     (narrow-to-region (point) (point))
  33.     (insert msg-string)
  34.     (narrow-to-region (point-min) (1- (point-max))))
  35.   (let ((error t)
  36.     (buffer-read-only nil))
  37.     (unwind-protect
  38.     (progn
  39.       (save-restriction
  40.         (goto-char (point-min))
  41.         (delete-region (point-min)
  42.                (progn (search-forward "\n*** EOOH ***\n")
  43.                   (point)))
  44.         (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
  45.         (narrow-to-region (point)
  46.                   (point-max))
  47.         (let* ((fill-prefix "")
  48.            (case-fold-search t)
  49.            (digest-name
  50.             (mail-strip-quoted-names
  51.              (or (save-restriction
  52.                (search-forward "\n\n")
  53.                (narrow-to-region (point-min) (point))
  54.                (goto-char (point-max))
  55.                (or (mail-fetch-field "Reply-To")
  56.                    (mail-fetch-field "To")
  57.                    (mail-fetch-field "Apparently-To")))
  58.              (error "Message is not a digest")))))
  59.           (save-excursion
  60.         (goto-char (point-max))
  61.         (skip-chars-backward " \t\n")
  62.         (let ((count 10) found)
  63.           ;; compensate for broken un*x digestifiers.  Sigh Sigh.
  64.           (while (and (> count 0) (not found))
  65.             (forward-line -1)
  66.             (setq count (1- count))
  67.             (if (looking-at (concat "End of.*Digest.*\n"
  68.                         (regexp-quote "*********") "*"
  69.                         "\\(\n------*\\)*"))
  70.             (setq found t)))
  71.           (if (not found) (error "Message is not a digest"))))
  72.           (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
  73.           (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
  74.           (save-restriction
  75.         (narrow-to-region (point)
  76.                   (progn (search-forward "\n\n")
  77.                      (point)))
  78.         (if (mail-fetch-field "To") nil
  79.           (goto-char (point-min))
  80.           (insert "To: " digest-name "\n")))
  81.           (while (re-search-forward
  82.               (concat "\n\n" (make-string 27 ?-) "-*\n*")
  83.               nil t)
  84.         (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
  85.         (save-restriction
  86.           (if (looking-at "End ")
  87.               (insert "To: " digest-name "\n\n")
  88.             (narrow-to-region (point)
  89.                       (progn (search-forward "\n\n"
  90.                                  nil 'move)
  91.                          (point))))
  92.           (if (mail-fetch-field "To") nil
  93.             (goto-char (point-min))
  94.             (insert "To: " digest-name "\n"))))))
  95.       (setq error nil)
  96.       (message "Message successfully undigestified")
  97.       (let ((n rmail-current-message))
  98.         (rmail-forget-messages)
  99.         (rmail-show-message n)
  100.         (rmail-delete-forward)))
  101.       (cond (error
  102.          (narrow-to-region (point-min) (1+ (point-max)))
  103.          (delete-region (point-min) (point-max))
  104.          (rmail-show-message rmail-current-message))))))
  105.  
  106.