1 ;;; undigest.el --- digest-cracking support for the RMAIL mail reader
3 ;; Copyright (C) 1985, 1986, 1994, 1996 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it 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 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; 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.
27 ;; See Internet RFC 934
33 (defun undigestify-rmail-message ()
34 "Break up a digest message into its constituent messages.
35 Leaves original message, deleted, before the undigestified messages."
38 (let ((buffer-read-only nil
)
39 (msg-string (buffer-substring (rmail-msgbeg rmail-current-message
)
40 (rmail-msgend rmail-current-message
))))
41 (goto-char (rmail-msgend rmail-current-message
))
42 (narrow-to-region (point) (point))
44 (narrow-to-region (point-min) (1- (point-max))))
46 (buffer-read-only nil
))
50 (goto-char (point-min))
51 (delete-region (point-min)
52 (progn (search-forward "\n*** EOOH ***\n")
54 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
55 (narrow-to-region (point)
57 (let* ((fill-prefix "")
61 (mail-strip-quoted-names
63 (search-forward "\n\n")
65 (narrow-to-region (point-min) (point))
66 (goto-char (point-max))
67 (or (mail-fetch-field "Reply-To")
68 (mail-fetch-field "To")
69 (mail-fetch-field "Apparently-To")
70 (mail-fetch-field "From")))
71 (error "Message is not a digest--bad header")))))
73 (goto-char (point-max))
74 (skip-chars-backward " \t\n")
76 ;; compensate for broken un*x digestifiers. Sigh Sigh.
77 (while (and (> (point) start
) (not found
))
79 (if (looking-at (concat "End of.*Digest.*\n"
80 (regexp-quote "*********") "*"
84 (error "Message is not a digest--no end line"))))
85 (re-search-forward (concat "^" (make-string 55 ?-
) "-*\n*"))
86 (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
88 (narrow-to-region (point)
89 (progn (search-forward "\n\n")
91 (if (mail-fetch-field "To") nil
92 (goto-char (point-min))
93 (insert "To: " digest-name
"\n")))
94 (while (re-search-forward
95 (concat "\n\n" (make-string 27 ?-
) "-*\n*")
97 (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
99 (if (looking-at "End ")
100 (insert "To: " digest-name
"\n\n")
101 (narrow-to-region (point)
102 (progn (search-forward "\n\n"
105 (if (mail-fetch-field "To")
107 (goto-char (point-min))
108 (insert "To: " digest-name
"\n")))
109 ;; Digestifiers may insert `- ' on lines that start with `-'.
112 (goto-char (point-min))
113 (if (re-search-forward
114 "\n\n----------------------------*\n*"
116 (let ((end (point-marker)))
117 (goto-char (point-min))
118 (while (re-search-forward "^- " end t
)
122 (message "Message successfully undigestified")
123 (let ((n rmail-current-message
))
124 (rmail-forget-messages)
125 (rmail-show-message n
)
126 (rmail-delete-forward)
127 (if (rmail-summary-exists)
128 (rmail-select-summary
129 (rmail-update-summary)))))
131 (narrow-to-region (point-min) (1+ (point-max)))
132 (delete-region (point-min) (point-max))
133 (rmail-show-message rmail-current-message
))))))
135 (defun unforward-rmail-message ()
136 "Extract a forwarded message from the containing message.
137 This puts the forwarded message into a separate rmail message
138 following the containing message."
140 (narrow-to-region (rmail-msgbeg rmail-current-message
)
141 (rmail-msgend rmail-current-message
))
142 (goto-char (point-min))
143 (let (beg end
(buffer-read-only nil
) msg-string who-forwarded-it
)
144 (setq who-forwarded-it
(mail-fetch-field "From"))
145 (if (re-search-forward "^----" nil t
)
147 (error "No forwarded message"))
150 (if (re-search-forward "^----" nil t
)
151 (setq end
(match-beginning 0))
152 (error "No terminator for forwarded message"))
154 (setq msg-string
(buffer-substring beg end
))
155 (goto-char (rmail-msgend rmail-current-message
))
156 (narrow-to-region (point) (point))
157 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
158 (narrow-to-region (point) (point))
159 (insert "Forwarded-by: " who-forwarded-it
"\n")
161 (goto-char (point-min))
163 (if (looking-at "- ")
164 (delete-region (point) (+ 2 (point))))
166 (let ((n rmail-current-message
))
167 (rmail-forget-messages)
168 (rmail-show-message n
)
169 (if (rmail-summary-exists)
170 (rmail-select-summary
171 (rmail-update-summary))))))
173 ;;; undigest.el ends here