aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1997-12-26 10:48:47 +0000
committerRichard M. Stallman1997-12-26 10:48:47 +0000
commitadd0c4548879d2deb8512aff35f0dc4224b87865 (patch)
tree3f459b90cedcb6ba9c64b687deea1c57ee134ced
parent1eff0ba1b757fee9f874c86dee349b4ff95e7d55 (diff)
downloademacs-add0c4548879d2deb8512aff35f0dc4224b87865.tar.gz
emacs-add0c4548879d2deb8512aff35f0dc4224b87865.zip
(undigestify-rmail-message): If in summary, switch to the Rmail buffer.
(unforward-rmail-message): Simplify using with-current-buffer.
-rw-r--r--lisp/mail/undigest.el264
1 files changed, 129 insertions, 135 deletions
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 87aa6f0d8d1..9ddfccac83e 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -35,103 +35,104 @@
35 "Break up a digest message into its constituent messages. 35 "Break up a digest message into its constituent messages.
36Leaves original message, deleted, before the undigestified messages." 36Leaves original message, deleted, before the undigestified messages."
37 (interactive) 37 (interactive)
38 (widen) 38 (with-current-buffer rmail-buffer
39 (let ((buffer-read-only nil) 39 (widen)
40 (msg-string (buffer-substring (rmail-msgbeg rmail-current-message) 40 (let ((buffer-read-only nil)
41 (rmail-msgend rmail-current-message)))) 41 (msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
42 (goto-char (rmail-msgend rmail-current-message)) 42 (rmail-msgend rmail-current-message))))
43 (narrow-to-region (point) (point)) 43 (goto-char (rmail-msgend rmail-current-message))
44 (insert msg-string) 44 (narrow-to-region (point) (point))
45 (narrow-to-region (point-min) (1- (point-max)))) 45 (insert msg-string)
46 (let ((error t) 46 (narrow-to-region (point-min) (1- (point-max))))
47 (buffer-read-only nil)) 47 (let ((error t)
48 (unwind-protect 48 (buffer-read-only nil))
49 (progn 49 (unwind-protect
50 (save-restriction 50 (progn
51 (goto-char (point-min)) 51 (save-restriction
52 (delete-region (point-min) 52 (goto-char (point-min))
53 (progn (search-forward "\n*** EOOH ***\n") 53 (delete-region (point-min)
54 (point))) 54 (progn (search-forward "\n*** EOOH ***\n")
55 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n") 55 (point)))
56 (narrow-to-region (point) 56 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
57 (point-max)) 57 (narrow-to-region (point)
58 (let* ((fill-prefix "") 58 (point-max))
59 (case-fold-search t) 59 (let* ((fill-prefix "")
60 start 60 (case-fold-search t)
61 (digest-name 61 start
62 (mail-strip-quoted-names 62 (digest-name
63 (or (save-restriction 63 (mail-strip-quoted-names
64 (search-forward "\n\n") 64 (or (save-restriction
65 (setq start (point)) 65 (search-forward "\n\n")
66 (narrow-to-region (point-min) (point)) 66 (setq start (point))
67 (goto-char (point-max)) 67 (narrow-to-region (point-min) (point))
68 (or (mail-fetch-field "Reply-To") 68 (goto-char (point-max))
69 (mail-fetch-field "To") 69 (or (mail-fetch-field "Reply-To")
70 (mail-fetch-field "Apparently-To") 70 (mail-fetch-field "To")
71 (mail-fetch-field "From"))) 71 (mail-fetch-field "Apparently-To")
72 (error "Message is not a digest--bad header"))))) 72 (mail-fetch-field "From")))
73 (save-excursion 73 (error "Message is not a digest--bad header")))))
74 (goto-char (point-max)) 74 (save-excursion
75 (skip-chars-backward " \t\n") 75 (goto-char (point-max))
76 (let (found) 76 (skip-chars-backward " \t\n")
77 ;; compensate for broken un*x digestifiers. Sigh Sigh. 77 (let (found)
78 (while (and (> (point) start) (not found)) 78 ;; compensate for broken un*x digestifiers. Sigh Sigh.
79 (forward-line -1) 79 (while (and (> (point) start) (not found))
80 (if (looking-at (concat "End of.*Digest.*\n" 80 (forward-line -1)
81 (regexp-quote "*********") "*" 81 (if (looking-at (concat "End of.*Digest.*\n"
82 "\\(\n------*\\)*")) 82 (regexp-quote "*********") "*"
83 (setq found t))) 83 "\\(\n------*\\)*"))
84 (if (not found) 84 (setq found t)))
85 (error "Message is not a digest--no end line")))) 85 (if (not found)
86 (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*")) 86 (error "Message is not a digest--no end line"))))
87 (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n") 87 (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
88 (save-restriction 88 (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
89 (narrow-to-region (point)
90 (progn (search-forward "\n\n")
91 (point)))
92 (if (mail-fetch-field "To") nil
93 (goto-char (point-min))
94 (insert "To: " digest-name "\n")))
95 (while (re-search-forward
96 (concat "\n\n" (make-string 27 ?-) "-*\n*")
97 nil t)
98 (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
99 (save-restriction 89 (save-restriction
100 (if (looking-at "End ") 90 (narrow-to-region (point)
101 (insert "To: " digest-name "\n\n") 91 (progn (search-forward "\n\n")
102 (narrow-to-region (point) 92 (point)))
103 (progn (search-forward "\n\n" 93 (if (mail-fetch-field "To") nil
104 nil 'move)
105 (point))))
106 (if (mail-fetch-field "To")
107 nil
108 (goto-char (point-min)) 94 (goto-char (point-min))
109 (insert "To: " digest-name "\n"))) 95 (insert "To: " digest-name "\n")))
110 ;; Digestifiers may insert `- ' on lines that start with `-'. 96 (while (re-search-forward
111 ;; Undo that. 97 (concat "\n\n" (make-string 27 ?-) "-*\n*")
112 (save-excursion 98 nil t)
113 (goto-char (point-min)) 99 (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
114 (if (re-search-forward 100 (save-restriction
115 "\n\n----------------------------*\n*" 101 (if (looking-at "End ")
116 nil t) 102 (insert "To: " digest-name "\n\n")
117 (let ((end (point-marker))) 103 (narrow-to-region (point)
118 (goto-char (point-min)) 104 (progn (search-forward "\n\n"
119 (while (re-search-forward "^- " end t) 105 nil 'move)
120 (delete-char -2))))) 106 (point))))
121 ))) 107 (if (mail-fetch-field "To")
122 (setq error nil) 108 nil
123 (message "Message successfully undigestified") 109 (goto-char (point-min))
124 (let ((n rmail-current-message)) 110 (insert "To: " digest-name "\n")))
125 (rmail-forget-messages) 111 ;; Digestifiers may insert `- ' on lines that start with `-'.
126 (rmail-show-message n) 112 ;; Undo that.
127 (rmail-delete-forward) 113 (save-excursion
128 (if (rmail-summary-exists) 114 (goto-char (point-min))
129 (rmail-select-summary 115 (if (re-search-forward
130 (rmail-update-summary))))) 116 "\n\n----------------------------*\n*"
131 (cond (error 117 nil t)
132 (narrow-to-region (point-min) (1+ (point-max))) 118 (let ((end (point-marker)))
133 (delete-region (point-min) (point-max)) 119 (goto-char (point-min))
134 (rmail-show-message rmail-current-message)))))) 120 (while (re-search-forward "^- " end t)
121 (delete-char -2)))))
122 )))
123 (setq error nil)
124 (message "Message successfully undigestified")
125 (let ((n rmail-current-message))
126 (rmail-forget-messages)
127 (rmail-show-message n)
128 (rmail-delete-forward)
129 (if (rmail-summary-exists)
130 (rmail-select-summary
131 (rmail-update-summary)))))
132 (cond (error
133 (narrow-to-region (point-min) (1+ (point-max)))
134 (delete-region (point-min) (point-max))
135 (rmail-show-message rmail-current-message)))))))
135 136
136;;;###autoload 137;;;###autoload
137(defun unforward-rmail-message () 138(defun unforward-rmail-message ()
@@ -139,47 +140,40 @@ Leaves original message, deleted, before the undigestified messages."
139This puts the forwarded message into a separate rmail message 140This puts the forwarded message into a separate rmail message
140following the containing message." 141following the containing message."
141 (interactive) 142 (interactive)
142 ;; Don't use save-excursion because we don't want to restore point 143 ;; If we are in a summary buffer, switch to the Rmail buffer.
143 ;; in the case where we do not switch buffers. 144 (with-current-buffer rmail-buffer
144 (let ((obuf (current-buffer))) 145 (narrow-to-region (rmail-msgbeg rmail-current-message)
145 (unwind-protect 146 (rmail-msgend rmail-current-message))
146 (progn 147 (goto-char (point-min))
147 ;; If we are in a summary buffer, switch to the Rmail buffer. 148 (let (beg end (buffer-read-only nil) msg-string who-forwarded-it)
148 (if (local-variable-p 'rmail-buffer) 149 (setq who-forwarded-it (mail-fetch-field "From"))
149 (set-buffer rmail-buffer)) 150 (if (re-search-forward "^----" nil t)
150 (narrow-to-region (rmail-msgbeg rmail-current-message) 151 nil
151 (rmail-msgend rmail-current-message)) 152 (error "No forwarded message"))
152 (goto-char (point-min)) 153 (forward-line 1)
153 (let (beg end (buffer-read-only nil) msg-string who-forwarded-it) 154 (setq beg (point))
154 (setq who-forwarded-it (mail-fetch-field "From")) 155 (if (re-search-forward "^----" nil t)
155 (if (re-search-forward "^----" nil t) 156 (setq end (match-beginning 0))
156 nil 157 (error "No terminator for forwarded message"))
157 (error "No forwarded message")) 158 (widen)
158 (forward-line 1) 159 (setq msg-string (buffer-substring beg end))
159 (setq beg (point)) 160 (goto-char (rmail-msgend rmail-current-message))
160 (if (re-search-forward "^----" nil t) 161 (narrow-to-region (point) (point))
161 (setq end (match-beginning 0)) 162 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
162 (error "No terminator for forwarded message")) 163 (narrow-to-region (point) (point))
163 (widen) 164 (insert "Forwarded-by: " who-forwarded-it "\n")
164 (setq msg-string (buffer-substring beg end)) 165 (insert msg-string)
165 (goto-char (rmail-msgend rmail-current-message)) 166 (goto-char (point-min))
166 (narrow-to-region (point) (point)) 167 (while (not (eobp))
167 (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n") 168 (if (looking-at "- ")
168 (narrow-to-region (point) (point)) 169 (delete-region (point) (+ 2 (point))))
169 (insert "Forwarded-by: " who-forwarded-it "\n") 170 (forward-line 1))
170 (insert msg-string) 171 (let ((n rmail-current-message))
171 (goto-char (point-min)) 172 (rmail-forget-messages)
172 (while (not (eobp)) 173 (rmail-show-message n)
173 (if (looking-at "- ") 174 (if (rmail-summary-exists)
174 (delete-region (point) (+ 2 (point)))) 175 (rmail-select-summary
175 (forward-line 1)) 176 (rmail-update-summary)))))))
176 (let ((n rmail-current-message))
177 (rmail-forget-messages)
178 (rmail-show-message n)
179 (if (rmail-summary-exists)
180 (rmail-select-summary
181 (rmail-update-summary))))))
182 (set-buffer obuf))))
183 177
184(provide 'undigest) 178(provide 'undigest)
185 179