1 ;;; undigest.el --- digest-cracking support for the RMAIL mail reader
3 ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
8 ;; This file is part of XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;; Synched up with: FSF 19.30.
29 ;; See Internet RFC 934
35 (defun undigestify-rmail-message ()
36 "Break up a digest message into its constituent messages.
37 Leaves original message, deleted, before the undigestified messages."
40 (let ((buffer-read-only nil)
41 (msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
42 (rmail-msgend rmail-current-message))))
43 (goto-char (rmail-msgend rmail-current-message))
44 (narrow-to-region (point) (point))
46 (narrow-to-region (point-min) (1- (point-max))))
48 (buffer-read-only nil))
52 (goto-char (point-min))
53 (delete-region (point-min)
54 (progn (search-forward "\n*** EOOH ***\n")
56 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
57 (narrow-to-region (point)
59 (let* ((fill-prefix "")
63 (mail-strip-quoted-names
65 (search-forward "\n\n")
67 (narrow-to-region (point-min) (point))
68 (goto-char (point-max))
69 (or (mail-fetch-field "Reply-To")
70 (mail-fetch-field "To")
71 (mail-fetch-field "Apparently-To")
72 (mail-fetch-field "From")))
73 (error "Message is not a digest--bad header")))))
75 (goto-char (point-max))
76 (skip-chars-backward " \t\n")
78 ;; compensate for broken un*x digestifiers. Sigh Sigh.
79 (while (and (> (point) start) (not found))
81 (if (looking-at (concat "End of.*Digest.*\n"
82 (regexp-quote "*********") "*"
86 (error "Message is not a digest--no end line"))))
87 (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
88 (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
90 (narrow-to-region (point)
91 (progn (search-forward "\n\n")
93 (if (mail-fetch-field "To") nil
94 (goto-char (point-min))
95 (insert "To: " digest-name "\n")))
96 (while (re-search-forward
97 (concat "\n\n" (make-string 27 ?-) "-*\n*")
99 (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
101 (if (looking-at "End ")
102 (insert "To: " digest-name "\n\n")
103 (narrow-to-region (point)
104 (progn (search-forward "\n\n"
107 (if (mail-fetch-field "To")
109 (goto-char (point-min))
110 (insert "To: " digest-name "\n")))
111 ;; Digestifiers may insert `- ' on lines that start with `-'.
114 (goto-char (point-min))
115 (if (re-search-forward
116 "\n\n----------------------------*\n*"
118 (let ((end (point-marker)))
119 (goto-char (point-min))
120 (while (re-search-forward "^- " end t)
124 (message "Message successfully undigestified")
125 (let ((n rmail-current-message))
126 (rmail-forget-messages)
127 (rmail-show-message n)
128 (rmail-delete-forward)
129 (if (rmail-summary-exists)
130 (rmail-select-summary
131 (rmail-update-summary)))))
133 (narrow-to-region (point-min) (1+ (point-max)))
134 (delete-region (point-min) (point-max))
135 (rmail-show-message rmail-current-message))))))
137 ;;; undigest.el ends here