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 (defcustom rmail-digest-end-regexps
34 (list (concat "End of.*Digest.*\n"
35 (regexp-quote "*********") "*"
38 (regexp-quote "*") "*"))
39 "*Regexps matching the end of a digest message."
41 :type
'(repeat regexp
))
44 (defun undigestify-rmail-message ()
45 "Break up a digest message into its constituent messages.
46 Leaves original message, deleted, before the undigestified messages."
48 (with-current-buffer rmail-buffer
50 (let ((buffer-read-only nil
)
51 (msg-string (buffer-substring (rmail-msgbeg rmail-current-message
)
52 (rmail-msgend rmail-current-message
))))
53 (goto-char (rmail-msgend rmail-current-message
))
54 (narrow-to-region (point) (point))
56 (narrow-to-region (point-min) (1- (point-max))))
58 (buffer-read-only nil
))
62 (goto-char (point-min))
63 (delete-region (point-min)
64 (progn (search-forward "\n*** EOOH ***\n")
66 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
67 (narrow-to-region (point)
69 (let* ((fill-prefix "")
73 (mail-strip-quoted-names
75 (search-forward "\n\n")
77 (narrow-to-region (point-min) (point))
78 (goto-char (point-max))
79 (or (mail-fetch-field "Reply-To")
80 (mail-fetch-field "To")
81 (mail-fetch-field "Apparently-To")
82 (mail-fetch-field "From")))
83 (error "Message is not a digest--bad header")))))
86 (regexps rmail-digest-end-regexps
))
87 (while (and regexps
(not found
))
88 (goto-char (point-max))
89 (skip-chars-backward " \t\n")
90 ;; compensate for broken un*x digestifiers. Sigh Sigh.
91 (while (and (> (point) start
) (not found
))
93 (if (looking-at (car regexps
))
95 (setq regexps
(cdr regexps
))))
97 (error "Message is not a digest--no end line"))))
98 (re-search-forward (concat "^" (make-string 55 ?-
) "-*\n*"))
99 (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
101 (narrow-to-region (point)
102 (progn (search-forward "\n\n")
104 (if (mail-fetch-field "To") nil
105 (goto-char (point-min))
106 (insert "To: " digest-name
"\n")))
107 (while (re-search-forward
108 (concat "\n\n" (make-string 27 ?-
) "-*\n*")
110 (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
112 (if (looking-at "End ")
113 (insert "To: " digest-name
"\n\n")
114 (narrow-to-region (point)
115 (progn (search-forward "\n\n"
118 (if (mail-fetch-field "To")
120 (goto-char (point-min))
121 (insert "To: " digest-name
"\n")))
122 ;; Digestifiers may insert `- ' on lines that start with `-'.
125 (goto-char (point-min))
126 (if (re-search-forward
127 "\n\n----------------------------*\n*"
129 (let ((end (point-marker)))
130 (goto-char (point-min))
131 (while (re-search-forward "^- " end t
)
135 (message "Message successfully undigestified")
136 (let ((n rmail-current-message
))
137 (rmail-forget-messages)
138 (rmail-show-message n
)
139 (rmail-delete-forward)
140 (if (rmail-summary-exists)
141 (rmail-select-summary
142 (rmail-update-summary)))))
144 (narrow-to-region (point-min) (1+ (point-max)))
145 (delete-region (point-min) (point-max))
146 (rmail-show-message rmail-current-message
)))))))
149 (defun unforward-rmail-message ()
150 "Extract a forwarded message from the containing message.
151 This puts the forwarded message into a separate rmail message
152 following the containing message."
154 ;; If we are in a summary buffer, switch to the Rmail buffer.
155 (with-current-buffer rmail-buffer
156 (narrow-to-region (rmail-msgbeg rmail-current-message
)
157 (rmail-msgend rmail-current-message
))
158 (goto-char (point-min))
159 (let (beg end
(buffer-read-only nil
) msg-string who-forwarded-it
)
160 (setq who-forwarded-it
(mail-fetch-field "From"))
161 (if (re-search-forward "^----" nil t
)
163 (error "No forwarded message"))
166 (if (re-search-forward "^----" nil t
)
167 (setq end
(match-beginning 0))
168 (error "No terminator for forwarded message"))
170 (setq msg-string
(buffer-substring beg end
))
171 (goto-char (rmail-msgend rmail-current-message
))
172 (narrow-to-region (point) (point))
173 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
174 (narrow-to-region (point) (point))
175 (insert "Forwarded-by: " who-forwarded-it
"\n")
177 (goto-char (point-min))
179 (if (looking-at "- ")
180 (delete-region (point) (+ 2 (point))))
182 (let ((n rmail-current-message
))
183 (rmail-forget-messages)
184 (rmail-show-message n
)
185 (if (rmail-summary-exists)
186 (rmail-select-summary
187 (rmail-update-summary)))))))
191 ;;; undigest.el ends here