![[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] / 43BSD / contrib / emacs / lisp|
Return to undigest.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; "RMAIL" mail reader for Emacs.
2: ;; Copyright (C) 1985 Richard M. Stallman.
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:
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: (error "Message is not a digest")))))
57: (save-excursion
58: (goto-char (point-max))
59: (skip-chars-backward " \t\n")
60: (forward-line -1)
61: (if (not (looking-at
62: (concat "End of.*Digest.*\n"
63: (regexp-quote "*********") "*$")))
64: (error "Message is not a digest")))
65: (re-search-forward (concat "^" (make-string 65 ?-) "-*\n*"))
66: (replace-match "\^_\^L\n0,unseen,,\n*** EOOH ***\n")
67: (save-restriction
68: (narrow-to-region (point)
69: (progn (search-forward "\n\n")
70: (point)))
71: (if (mail-fetch-field "To") nil
72: (goto-char (point-min))
73: (insert "To: " digest-name "\n")))
74: (while (re-search-forward
75: (concat "\n\n" (make-string 27 ?-)
76: "-?-?-?-?-?-?\n*")
77: nil t)
78: (replace-match "\n\n\^_\^L\n0,unseen,,\n*** EOOH ***\n")
79: (save-restriction
80: (if (looking-at "End ")
81: (insert "To: " digest-name "\n\n")
82: (narrow-to-region (point)
83: (progn (search-forward "\n\n"
84: nil 'move)
85: (point))))
86: (if (mail-fetch-field "To") nil
87: (goto-char (point-min))
88: (insert "To: " digest-name "\n"))))))
89: (setq error_ nil)
90: (message "Message successfully undigestified")
91: (let ((n rmail-current-message))
92: (rmail-forget-messages)
93: (rmail-show-message n)
94: (rmail-delete-forward)))
95: (cond (error_
96: (delete-region (point-min) (point-max))
97: (rmail-show-message rmail-current-message))))))
98:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.