![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to undigest.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.