![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to undigest.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to undigest.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 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 free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;; note Interent RFP934
21:
22: (defun undigestify-rmail-message ()
23: "Break up a digest message into its constituent messages.
24: Leaves original message, deleted, before the undigestified messages."
25: (interactive)
26: (widen)
27: (let ((buffer-read-only nil)
28: (msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
29: (rmail-msgend rmail-current-message))))
30: (goto-char (rmail-msgend rmail-current-message))
31: (narrow-to-region (point) (point))
32: (insert msg-string)
33: (narrow-to-region (point-min) (1- (point-max))))
34: (let ((error t)
35: (buffer-read-only nil))
36: (unwind-protect
37: (progn
38: (save-restriction
39: (goto-char (point-min))
40: (delete-region (point-min)
41: (progn (search-forward "\n*** EOOH ***\n")
42: (point)))
43: (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
44: (narrow-to-region (point)
45: (point-max))
46: (let* ((fill-prefix "")
47: (case-fold-search t)
48: (digest-name
49: (mail-strip-quoted-names
50: (or (save-restriction
51: (search-forward "\n\n")
52: (narrow-to-region (point-min) (point))
53: (goto-char (point-max))
54: (or (mail-fetch-field "Reply-To")
55: (mail-fetch-field "To")
56: (mail-fetch-field "Apparently-To")))
57: (error "Message is not a digest")))))
58: (save-excursion
59: (goto-char (point-max))
60: (skip-chars-backward " \t\n")
61: (let ((count 10) found)
62: ;; compensate for broken un*x digestifiers. Sigh Sigh.
63: (while (and (> count 0) (not found))
64: (forward-line -1)
65: (setq count (1- count))
66: (if (looking-at (concat "End of.*Digest.*\n"
67: (regexp-quote "*********") "*"
68: "\\(\n------*\\)*"))
69: (setq found t)))
70: (if (not found) (error "Message is not a digest"))))
71: (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
72: (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
73: (save-restriction
74: (narrow-to-region (point)
75: (progn (search-forward "\n\n")
76: (point)))
77: (if (mail-fetch-field "To") nil
78: (goto-char (point-min))
79: (insert "To: " digest-name "\n")))
80: (while (re-search-forward
81: (concat "\n\n" (make-string 27 ?-) "-*\n*")
82: nil t)
83: (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
84: (save-restriction
85: (if (looking-at "End ")
86: (insert "To: " digest-name "\n\n")
87: (narrow-to-region (point)
88: (progn (search-forward "\n\n"
89: nil 'move)
90: (point))))
91: (if (mail-fetch-field "To") nil
92: (goto-char (point-min))
93: (insert "To: " digest-name "\n"))))))
94: (setq error nil)
95: (message "Message successfully undigestified")
96: (let ((n rmail-current-message))
97: (rmail-forget-messages)
98: (rmail-show-message n)
99: (rmail-delete-forward)))
100: (cond (error
101: (narrow-to-region (point-min) (1+ (point-max)))
102: (delete-region (point-min) (point-max))
103: (rmail-show-message rmail-current-message))))))
104:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.