Mercurial > hg > xemacs-beta
comparison lisp/vm/vm-reply.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; Mailing, forwarding, and replying commands for VM | |
| 2 ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones | |
| 3 ;;; | |
| 4 ;;; This program is free software; you can redistribute it and/or modify | |
| 5 ;;; it under the terms of the GNU General Public License as published by | |
| 6 ;;; the Free Software Foundation; either version 1, or (at your option) | |
| 7 ;;; any later version. | |
| 8 ;;; | |
| 9 ;;; This program is distributed in the hope that it will be useful, | |
| 10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 12 ;;; GNU General Public License for more details. | |
| 13 ;;; | |
| 14 ;;; You should have received a copy of the GNU General Public License | |
| 15 ;;; along with this program; if not, write to the Free Software | |
| 16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 17 | |
| 18 (provide 'vm-reply) | |
| 19 | |
| 20 (defun vm-do-reply (to-all include-text count) | |
| 21 (let ((mlist (vm-select-marked-or-prefixed-messages count)) | |
| 22 (dir default-directory) | |
| 23 (message-pointer vm-message-pointer) | |
| 24 (case-fold-search t) | |
| 25 to cc subject mp in-reply-to references tmp tmp2 newsgroups) | |
| 26 (setq mp mlist) | |
| 27 (while mp | |
| 28 (cond | |
| 29 ((eq mlist mp) | |
| 30 (cond ((setq to | |
| 31 (let ((reply-to | |
| 32 (vm-get-header-contents (car mp) "Reply-To:"))) | |
| 33 (if (vm-ignored-reply-to reply-to) | |
| 34 nil | |
| 35 reply-to )))) | |
| 36 ((setq to (vm-get-header-contents (car mp) "From:"))) | |
| 37 ;; bad, but better than nothing for some | |
| 38 ((setq to (vm-grok-From_-author (car mp)))) | |
| 39 (t (error "No From: or Reply-To: header in message"))) | |
| 40 (setq subject (vm-get-header-contents (car mp) "Subject:") | |
| 41 in-reply-to | |
| 42 (and vm-in-reply-to-format | |
| 43 (let ((vm-summary-uninteresting-senders nil)) | |
| 44 (vm-sprintf 'vm-in-reply-to-format (car mp)))) | |
| 45 in-reply-to (and (not (equal "" in-reply-to)) in-reply-to)) | |
| 46 (and subject vm-reply-subject-prefix | |
| 47 (let ((case-fold-search t)) | |
| 48 (not | |
| 49 (equal | |
| 50 (string-match (regexp-quote vm-reply-subject-prefix) | |
| 51 subject) | |
| 52 0))) | |
| 53 (setq subject (concat vm-reply-subject-prefix subject)))) | |
| 54 (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:")) | |
| 55 (setq to (concat to "," tmp))) | |
| 56 ((setq tmp (vm-get-header-contents (car mp) "From:")) | |
| 57 (setq to (concat to "," tmp))) | |
| 58 ;; bad, but better than nothing for some | |
| 59 ((setq tmp (vm-grok-From_-author (car mp))) | |
| 60 (setq to (concat to "," tmp))) | |
| 61 (t (error "No From: or Reply-To: header in message"))))) | |
| 62 (if to-all | |
| 63 (progn | |
| 64 (setq tmp (vm-get-header-contents (car mp) "To:")) | |
| 65 (setq tmp2 (vm-get-header-contents (car mp) "Cc:")) | |
| 66 (if tmp | |
| 67 (if cc | |
| 68 (setq cc (concat cc "," tmp)) | |
| 69 (setq cc tmp))) | |
| 70 (if tmp2 | |
| 71 (if cc | |
| 72 (setq cc (concat cc "," tmp2)) | |
| 73 (setq cc tmp2))))) | |
| 74 (setq references | |
| 75 (cons (vm-get-header-contents (car mp) "References:") | |
| 76 (cons (vm-get-header-contents (car mp) "In-reply-to:") | |
| 77 (cons (vm-get-header-contents (car mp) "Message-ID:") | |
| 78 references)))) | |
| 79 (setq newsgroups | |
| 80 (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:")) | |
| 81 (vm-get-header-contents (car mp) "Newsgroups:")) | |
| 82 newsgroups)) | |
| 83 (setq mp (cdr mp))) | |
| 84 (if vm-strip-reply-headers | |
| 85 (let ((mail-use-rfc822 t)) | |
| 86 (and to (setq to (mail-strip-quoted-names to))) | |
| 87 (and cc (setq cc (mail-strip-quoted-names cc))))) | |
| 88 (setq to (vm-parse-addresses to) | |
| 89 cc (vm-parse-addresses cc)) | |
| 90 (if vm-reply-ignored-addresses | |
| 91 (setq to (vm-strip-ignored-addresses to) | |
| 92 cc (vm-strip-ignored-addresses cc))) | |
| 93 (setq to (vm-delete-duplicates to nil t)) | |
| 94 (setq cc (vm-delete-duplicates | |
| 95 (append (vm-delete-duplicates cc nil t) | |
| 96 to (copy-sequence to)) | |
| 97 t t)) | |
| 98 (and to (setq to (mapconcat 'identity to ",\n "))) | |
| 99 (and cc (setq cc (mapconcat 'identity cc ",\n "))) | |
| 100 (and (null to) (setq to cc cc nil)) | |
| 101 (setq references (delq nil references) | |
| 102 references (mapconcat 'identity references " ") | |
| 103 references (vm-parse references "[^<]*\\(<[^>]+>\\)") | |
| 104 references (vm-delete-duplicates references) | |
| 105 references (if references (mapconcat 'identity references "\n\t"))) | |
| 106 (setq newsgroups (delq nil newsgroups) | |
| 107 newsgroups (mapconcat 'identity newsgroups ",") | |
| 108 newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)") | |
| 109 newsgroups (vm-delete-duplicates newsgroups) | |
| 110 newsgroups (if newsgroups (mapconcat 'identity newsgroups ","))) | |
| 111 (vm-mail-internal | |
| 112 (format "reply to %s%s" (vm-su-full-name (car mlist)) | |
| 113 (if (cdr mlist) ", ..." "")) | |
| 114 to subject in-reply-to cc references newsgroups) | |
| 115 (make-local-variable 'vm-reply-list) | |
| 116 (setq vm-system-state 'replying | |
| 117 vm-reply-list mlist | |
| 118 default-directory dir) | |
| 119 (if include-text | |
| 120 (save-excursion | |
| 121 (goto-char (point-min)) | |
| 122 (let ((case-fold-search nil)) | |
| 123 (re-search-forward | |
| 124 (concat "^" (regexp-quote mail-header-separator) "$") nil 0)) | |
| 125 (forward-char 1) | |
| 126 (while mlist | |
| 127 (vm-yank-message (car mlist)) | |
| 128 (goto-char (point-max)) | |
| 129 (setq mlist (cdr mlist))))) | |
| 130 (run-hooks 'vm-reply-hook) | |
| 131 (run-hooks 'vm-mail-mode-hook))) | |
| 132 | |
| 133 (defun vm-strip-ignored-addresses (addresses) | |
| 134 (setq addresses (copy-sequence addresses)) | |
| 135 (let (re-list list addr-list) | |
| 136 (setq re-list vm-reply-ignored-addresses) | |
| 137 (while re-list | |
| 138 (setq addr-list addresses) | |
| 139 (while addr-list | |
| 140 (if (string-match (car re-list) (car addr-list)) | |
| 141 (setq addresses (delq (car addr-list) addresses))) | |
| 142 (setq addr-list (cdr addr-list))) | |
| 143 (setq re-list (cdr re-list)))) | |
| 144 addresses ) | |
| 145 | |
| 146 (defun vm-ignored-reply-to (reply-to) | |
| 147 (if reply-to | |
| 148 (let (re-list result) | |
| 149 (setq re-list vm-reply-ignored-reply-tos) | |
| 150 (while re-list | |
| 151 (if (string-match (car re-list) reply-to) | |
| 152 (setq result t re-list nil) | |
| 153 (setq re-list (cdr re-list)))) | |
| 154 result ))) | |
| 155 | |
| 156 (defun vm-mail-yank-default (message) | |
| 157 (save-excursion | |
| 158 (vm-reorder-message-headers nil vm-included-text-headers | |
| 159 vm-included-text-discard-header-regexp) | |
| 160 ;; if all the headers are gone, delete the trailing blank line, too. | |
| 161 (if (eq (following-char) ?\n) | |
| 162 (delete-char 1)) | |
| 163 (if vm-included-text-attribution-format | |
| 164 (let ((vm-summary-uninteresting-senders nil)) | |
| 165 (insert (vm-sprintf 'vm-included-text-attribution-format message)))) | |
| 166 ; turn off zmacs-regions for Lucid Emacs 19 | |
| 167 ; and get around transient-mark-mode in FSF Emacs 19 | |
| 168 ; all this so that (mark) does what it did in v18, sheesh. | |
| 169 (let* ((zmacs-regions nil) | |
| 170 (mark-even-if-inactive t) | |
| 171 (end (mark-marker))) | |
| 172 (while (< (point) end) | |
| 173 (insert vm-included-text-prefix) | |
| 174 (forward-line 1))))) | |
| 175 | |
| 176 (defun vm-yank-message-other-folder (folder) | |
| 177 "Like vm-yank-message except the message is yanked from a folder other | |
| 178 than the one that spawned the current Mail mode buffer. The name of the | |
| 179 folder is read from the minibuffer. | |
| 180 | |
| 181 Don't call this function from a program." | |
| 182 (interactive | |
| 183 (list | |
| 184 (let ((dir (if vm-folder-directory | |
| 185 (expand-file-name vm-folder-directory) | |
| 186 default-directory)) | |
| 187 (last-command last-command) | |
| 188 (this-command this-command)) | |
| 189 (read-file-name "Yank from folder: " dir nil t)))) | |
| 190 (let ((b (current-buffer)) newbuf sumbuf default result prompt mp) | |
| 191 (set-buffer (or (vm-get-file-buffer folder) (find-file-noselect folder))) | |
| 192 (setq newbuf (current-buffer)) | |
| 193 (if (not (eq major-mode 'vm-mode)) | |
| 194 (vm-mode)) | |
| 195 (if (null vm-message-pointer) | |
| 196 (error "No messages in folder %s" folder)) | |
| 197 (setq default (vm-number-of (car vm-message-pointer))) | |
| 198 (save-excursion | |
| 199 (save-window-excursion | |
| 200 (save-window-excursion | |
| 201 (vm-summarize)) | |
| 202 (vm-display vm-summary-buffer t '(vm-yank-message-other-folder) | |
| 203 '(vm-yank-message-other-folder composing-message)) | |
| 204 (setq sumbuf (current-buffer)) | |
| 205 (setq prompt (format "Yank message number: (default %s) " default) | |
| 206 result 0) | |
| 207 (while (zerop result) | |
| 208 (setq result (read-string prompt)) | |
| 209 (and (string= result "") default (setq result default)) | |
| 210 (setq result (string-to-int result))) | |
| 211 (if (null (setq mp (nthcdr (1- result) vm-message-list))) | |
| 212 (error "No such message.")))) | |
| 213 (set-buffer b) | |
| 214 (unwind-protect | |
| 215 (let ((vm-mail-buffer newbuf)) | |
| 216 (vm-yank-message (car mp))) | |
| 217 (vm-bury-buffer newbuf) | |
| 218 (vm-bury-buffer sumbuf)))) | |
| 219 | |
| 220 (defun vm-yank-message (message) | |
| 221 "Yank message number N into the current buffer at point. | |
| 222 When called interactively N is always read from the minibuffer. When | |
| 223 called non-interactively the first argument is expected to be a | |
| 224 message struct. | |
| 225 | |
| 226 This command is meant to be used in VM created Mail mode buffers; the | |
| 227 yanked message comes from the mail buffer containing the message you | |
| 228 are replying to, forwarding, or invoked VM's mail command from. | |
| 229 | |
| 230 All message headers are yanked along with the text. Point is | |
| 231 left before the inserted text, the mark after. Any hook | |
| 232 functions bound to mail-citation-hook are run, after inserting | |
| 233 the text and setting point and mark. For backward compatibility, | |
| 234 if mail-citation-hook is set to nil, `mail-yank-hooks' is run | |
| 235 instead. | |
| 236 | |
| 237 If mail-citation-hook and mail-yank-hooks are both nil, this | |
| 238 default action is taken: the yanked headers are trimmed as | |
| 239 specified by vm-included-text-headers and | |
| 240 vm-included-text-discard-header-regexp, and the value of | |
| 241 vm-included-text-prefix is prepended to every yanked line." | |
| 242 (interactive | |
| 243 (list | |
| 244 ;; What we really want for the first argument is a message struct, | |
| 245 ;; but if called interactively, we let the user type in a message | |
| 246 ;; number instead. | |
| 247 (let (mp default | |
| 248 (result 0) | |
| 249 prompt | |
| 250 (last-command last-command) | |
| 251 (this-command this-command)) | |
| 252 (save-excursion | |
| 253 (vm-select-folder-buffer) | |
| 254 (setq default (and vm-message-pointer | |
| 255 (vm-number-of (car vm-message-pointer))) | |
| 256 prompt (if default | |
| 257 (format "Yank message number: (default %s) " | |
| 258 default) | |
| 259 "Yank message number: ")) | |
| 260 (while (zerop result) | |
| 261 (setq result (read-string prompt)) | |
| 262 (and (string= result "") default (setq result default)) | |
| 263 (setq result (string-to-int result))) | |
| 264 (if (null (setq mp (nthcdr (1- result) vm-message-list))) | |
| 265 (error "No such message."))) | |
| 266 (car mp)))) | |
| 267 (if (not (bufferp vm-mail-buffer)) | |
| 268 (error "This is not a VM Mail mode buffer.")) | |
| 269 (if (null (buffer-name vm-mail-buffer)) | |
| 270 (error "The folder buffer containing message %d has been killed." | |
| 271 (vm-number-of message))) | |
| 272 (vm-display nil nil '(vm-yank-message) '(vm-yank-message composing-message)) | |
| 273 (setq message (vm-real-message-of message)) | |
| 274 (let ((b (current-buffer)) (start (point)) end) | |
| 275 (save-restriction | |
| 276 (widen) | |
| 277 (save-excursion | |
| 278 (set-buffer (vm-buffer-of message)) | |
| 279 (save-restriction | |
| 280 (widen) | |
| 281 (append-to-buffer b (vm-headers-of message) (vm-text-end-of message)) | |
| 282 (setq end (vm-marker (+ start (- (vm-text-end-of message) | |
| 283 (vm-headers-of message))) b)))) | |
| 284 (push-mark end) | |
| 285 (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) | |
| 286 (mail-yank-hooks (run-hooks 'mail-yank-hooks)) | |
| 287 (t (vm-mail-yank-default message)))))) | |
| 288 | |
| 289 (defun vm-mail-send-and-exit (arg) | |
| 290 "Just like mail-send-and-exit except that VM flags the appropriate message(s) | |
| 291 as having been replied to, if appropriate." | |
| 292 (interactive "P") | |
| 293 (let ((b (current-buffer))) | |
| 294 (vm-mail-send) | |
| 295 (cond ((null (buffer-name b)) ;; dead buffer | |
| 296 (vm-display nil nil '(vm-mail-send-and-exit) | |
| 297 '(vm-mail-send-and-exit reading-message startup))) | |
| 298 (t | |
| 299 (vm-display b nil '(vm-mail-send-and-exit) | |
| 300 '(vm-mail-send-and-exit reading-message startup)) | |
| 301 (vm-bury-buffer b))))) | |
| 302 | |
| 303 (defun vm-keep-mail-buffer (buffer) | |
| 304 ;; keep this buffer if the user demands it | |
| 305 (if (memq buffer vm-kept-mail-buffers) | |
| 306 (setq vm-kept-mail-buffers | |
| 307 (delq buffer vm-kept-mail-buffers))) | |
| 308 (setq vm-kept-mail-buffers (cons buffer vm-kept-mail-buffers) | |
| 309 vm-kept-mail-buffers (vm-delete 'buffer-name | |
| 310 vm-kept-mail-buffers t)) | |
| 311 (if (not (eq vm-keep-sent-messages t)) | |
| 312 (let ((extras (nthcdr (or vm-keep-sent-messages 0) | |
| 313 vm-kept-mail-buffers))) | |
| 314 (mapcar (function | |
| 315 (lambda (b) | |
| 316 (and (buffer-name b) (kill-buffer b)))) | |
| 317 extras) | |
| 318 (and vm-kept-mail-buffers extras | |
| 319 (setcdr (memq (car extras) vm-kept-mail-buffers) nil))))) | |
| 320 | |
| 321 (defun vm-help-tale () | |
| 322 (save-excursion | |
| 323 (goto-char (point-min)) | |
| 324 (while (vm-match-header) | |
| 325 (if (not (vm-match-header "To:\\|Resent-To:\\|Cc:\\|Resent-Cc:")) | |
| 326 (goto-char (vm-matched-header-end)) | |
| 327 (goto-char (vm-matched-header-contents-start)) | |
| 328 (if (re-search-forward "[^, \t][ \t]*\n[ \t\n]+[^ \t\n]" | |
| 329 (vm-matched-header-contents-end) | |
| 330 t) | |
| 331 (error "tale is an idiot, and so are you. :-)")) | |
| 332 (goto-char (vm-matched-header-end)))))) | |
| 333 | |
| 334 (defun vm-mail-send () | |
| 335 "Just like mail-send except that VM flags the appropriate message(s) | |
| 336 as replied to, forwarded, etc, if appropriate." | |
| 337 (interactive) | |
| 338 (if vm-tale-is-an-idiot | |
| 339 (vm-help-tale)) | |
| 340 (if (and vm-confirm-mail-send | |
| 341 (not (y-or-n-p "Send the message? "))) | |
| 342 (error "Message not sent.")) | |
| 343 ;; this to prevent Emacs 19 from asking whether a message that | |
| 344 ;; has already been sent should be sent again. VM renames mail | |
| 345 ;; buffers after the message has been sent, so the user should | |
| 346 ;; already know that the message has been sent. | |
| 347 (set-buffer-modified-p t) | |
| 348 ;; don't want a buffer change to occur here | |
| 349 ;; save-excursion to be sure. | |
| 350 (save-excursion | |
| 351 (mail-send)) | |
| 352 (vm-rename-current-mail-buffer) | |
| 353 (cond ((eq vm-system-state 'replying) | |
| 354 (vm-mail-mark-replied)) | |
| 355 ((eq vm-system-state 'forwarding) | |
| 356 (vm-mail-mark-forwarded)) | |
| 357 ((eq vm-system-state 'redistributing) | |
| 358 (vm-mail-mark-redistributed))) | |
| 359 (vm-keep-mail-buffer (current-buffer)) | |
| 360 (vm-display nil nil '(vm-mail-send) '(vm-mail-send))) | |
| 361 | |
| 362 (defun vm-rename-current-mail-buffer () | |
| 363 (if vm-rename-current-buffer-function | |
| 364 (funcall vm-rename-current-buffer-function) | |
| 365 (let ((case-fold-search nil)) | |
| 366 (if (not (string-match "^sent " (buffer-name))) | |
| 367 (let (prefix name n) | |
| 368 (if (not (= ?* (aref (buffer-name) 0))) | |
| 369 (setq prefix (format "sent %s" (buffer-name))) | |
| 370 (let (recipients) | |
| 371 (cond ((not (zerop (length (setq recipients | |
| 372 (mail-fetch-field "To")))))) | |
| 373 ((not (zerop (length (setq recipients | |
| 374 (mail-fetch-field "Cc")))))) | |
| 375 ((not (zerop (length (setq recipients | |
| 376 (mail-fetch-field "Bcc")))))) | |
| 377 ; can't happen?!? | |
| 378 (t (setq recipients "the horse with no name"))) | |
| 379 (setq prefix (format "sent mail to %s" recipients)))) | |
| 380 (if (> (length prefix) 44) | |
| 381 (setq prefix (concat (substring prefix 0 40) " ..."))) | |
| 382 (setq name prefix n 2) | |
| 383 (while (get-buffer name) | |
| 384 (setq name (format "%s<%d>" prefix n)) | |
| 385 (vm-increment n)) | |
| 386 (rename-buffer name)))))) | |
| 387 | |
| 388 (defun vm-mail-mark-replied () | |
| 389 (save-excursion | |
| 390 (let ((mp vm-reply-list)) | |
| 391 (while mp | |
| 392 (if (null (buffer-name (vm-buffer-of (car mp)))) | |
| 393 () | |
| 394 (set-buffer (vm-buffer-of (car mp))) | |
| 395 (cond ((and (memq (car mp) vm-message-list) | |
| 396 (null (vm-replied-flag (car mp)))) | |
| 397 (vm-set-replied-flag (car mp) t)))) | |
| 398 (setq mp (cdr mp))) | |
| 399 (vm-update-summary-and-mode-line)))) | |
| 400 | |
| 401 (defun vm-mail-mark-forwarded () | |
| 402 (save-excursion | |
| 403 (let ((mp vm-forward-list)) | |
| 404 (while mp | |
| 405 (if (null (buffer-name (vm-buffer-of (car mp)))) | |
| 406 () | |
| 407 (set-buffer (vm-buffer-of (car mp))) | |
| 408 (cond ((and (memq (car mp) vm-message-list) | |
| 409 (null (vm-forwarded-flag (car mp)))) | |
| 410 (vm-set-forwarded-flag (car mp) t)))) | |
| 411 (setq mp (cdr mp))) | |
| 412 (vm-update-summary-and-mode-line)))) | |
| 413 | |
| 414 (defun vm-mail-mark-redistributed () | |
| 415 (save-excursion | |
| 416 (let ((mp vm-redistribute-list)) | |
| 417 (while mp | |
| 418 (if (null (buffer-name (vm-buffer-of (car mp)))) | |
| 419 () | |
| 420 (set-buffer (vm-buffer-of (car mp))) | |
| 421 (cond ((and (memq (car mp) vm-message-list) | |
| 422 (null (vm-redistributed-flag (car mp)))) | |
| 423 (vm-set-redistributed-flag (car mp) t)))) | |
| 424 (setq mp (cdr mp))) | |
| 425 (vm-update-summary-and-mode-line)))) | |
| 426 | |
| 427 (defun vm-reply (count) | |
| 428 "Reply to the sender of the current message. | |
| 429 Numeric prefix argument N means to reply to the current message plus the | |
| 430 next N-1 messages. A negative N means reply to the current message and | |
| 431 the previous N-1 messages. | |
| 432 | |
| 433 If invoked on marked messages (via vm-next-command-uses-marks), | |
| 434 all marked messages will be replied to. | |
| 435 | |
| 436 You will be placed into a standard Emacs Mail mode buffer to compose and | |
| 437 send your message. See the documentation for the function `mail' for | |
| 438 more info. | |
| 439 | |
| 440 Note that the normal binding of C-c C-y in the reply buffer is | |
| 441 automatically changed to vm-yank-message during a reply. This | |
| 442 allows you to yank any message from the current folder into a | |
| 443 reply. | |
| 444 | |
| 445 Normal VM commands may be accessed in the reply buffer by prefixing them | |
| 446 with C-c C-v." | |
| 447 (interactive "p") | |
| 448 (vm-follow-summary-cursor) | |
| 449 (vm-select-folder-buffer) | |
| 450 (vm-check-for-killed-summary) | |
| 451 (vm-error-if-folder-empty) | |
| 452 (vm-do-reply nil nil count)) | |
| 453 | |
| 454 (defun vm-reply-include-text (count) | |
| 455 "Reply to the sender (only) of the current message and include text | |
| 456 from the message. See the documentation for function vm-reply for details." | |
| 457 (interactive "p") | |
| 458 (vm-follow-summary-cursor) | |
| 459 (vm-select-folder-buffer) | |
| 460 (vm-check-for-killed-summary) | |
| 461 (vm-error-if-folder-empty) | |
| 462 (vm-do-reply nil t count)) | |
| 463 | |
| 464 (defun vm-followup (count) | |
| 465 "Reply to all recipients of the current message. | |
| 466 See the documentation for the function vm-reply for details." | |
| 467 (interactive "p") | |
| 468 (vm-follow-summary-cursor) | |
| 469 (vm-select-folder-buffer) | |
| 470 (vm-check-for-killed-summary) | |
| 471 (vm-error-if-folder-empty) | |
| 472 (vm-do-reply t nil count)) | |
| 473 | |
| 474 (defun vm-followup-include-text (count) | |
| 475 "Reply to all recipients of the current message and include text from | |
| 476 the message. See the documentation for the function vm-reply for details." | |
| 477 (interactive "p") | |
| 478 (vm-follow-summary-cursor) | |
| 479 (vm-select-folder-buffer) | |
| 480 (vm-check-for-killed-summary) | |
| 481 (vm-error-if-folder-empty) | |
| 482 (vm-do-reply t t count)) | |
| 483 | |
| 484 (defun vm-forward-message-all-headers () | |
| 485 "Like vm-forward-message but always forwards all the headers." | |
| 486 (interactive) | |
| 487 (let ((vm-forwarded-headers nil) | |
| 488 (vm-unforwarded-header-regexp "only-drop-this-header")) | |
| 489 (vm-forward-message))) | |
| 490 | |
| 491 (defun vm-forward-message () | |
| 492 "Forward the current message to one or more recipients. | |
| 493 You will be placed in a Mail mode buffer as you would with a | |
| 494 reply, but you must fill in the To: header and perhaps the | |
| 495 Subject: header manually." | |
| 496 (interactive) | |
| 497 (vm-follow-summary-cursor) | |
| 498 (vm-select-folder-buffer) | |
| 499 (vm-check-for-killed-summary) | |
| 500 (vm-error-if-folder-empty) | |
| 501 (if (eq last-command 'vm-next-command-uses-marks) | |
| 502 (let ((vm-digest-send-type vm-forwarding-digest-type)) | |
| 503 (setq this-command 'vm-next-command-uses-marks) | |
| 504 (command-execute 'vm-send-digest)) | |
| 505 (let ((dir default-directory) | |
| 506 (mp vm-message-pointer)) | |
| 507 (save-restriction | |
| 508 (widen) | |
| 509 (vm-mail-internal | |
| 510 (format "forward of %s's note re: %s" | |
| 511 (vm-su-full-name (car vm-message-pointer)) | |
| 512 (vm-su-subject (car vm-message-pointer))) | |
| 513 nil | |
| 514 (and vm-forwarding-subject-format | |
| 515 (let ((vm-summary-uninteresting-senders nil)) | |
| 516 (vm-sprintf 'vm-forwarding-subject-format (car mp))))) | |
| 517 (make-local-variable 'vm-forward-list) | |
| 518 (setq vm-system-state 'forwarding | |
| 519 vm-forward-list (list (car mp)) | |
| 520 default-directory dir) | |
| 521 (goto-char (point-min)) | |
| 522 (re-search-forward | |
| 523 (concat "^" (regexp-quote mail-header-separator) "\n") nil 0) | |
| 524 (cond ((equal vm-forwarding-digest-type "rfc934") | |
| 525 (vm-rfc934-encapsulate-messages | |
| 526 vm-forward-list vm-forwarded-headers | |
| 527 vm-unforwarded-header-regexp)) | |
| 528 ((equal vm-forwarding-digest-type "rfc1153") | |
| 529 (vm-rfc1153-encapsulate-messages | |
| 530 vm-forward-list vm-forwarded-headers | |
| 531 vm-unforwarded-header-regexp)) | |
| 532 ((equal vm-forwarding-digest-type nil) | |
| 533 (vm-no-frills-encapsulate-message | |
| 534 (car vm-forward-list) vm-forwarded-headers | |
| 535 vm-unforwarded-header-regexp))) | |
| 536 (mail-position-on-field "To")) | |
| 537 (run-hooks 'vm-forward-message-hook) | |
| 538 (run-hooks 'vm-mail-mode-hook)))) | |
| 539 | |
| 540 (defun vm-resend-bounced-message () | |
| 541 "Extract the original text from a bounced message and resend it. | |
| 542 You will be placed in a Mail mode buffer with the extracted message and | |
| 543 you can change the recipient address before resending the message." | |
| 544 (interactive) | |
| 545 (vm-follow-summary-cursor) | |
| 546 (vm-select-folder-buffer) | |
| 547 (vm-check-for-killed-summary) | |
| 548 (vm-error-if-folder-empty) | |
| 549 (let ((b (current-buffer)) start | |
| 550 (dir default-directory) | |
| 551 (lim (vm-text-end-of (car vm-message-pointer)))) | |
| 552 (save-restriction | |
| 553 (widen) | |
| 554 (save-excursion | |
| 555 (goto-char (vm-text-of (car vm-message-pointer))) | |
| 556 (let ((case-fold-search t)) | |
| 557 ;; What a wonderful world it would be if mailers used a single | |
| 558 ;; message encapsulation standard instead all the weird variants | |
| 559 ;; It is useless to try to cover them all. | |
| 560 ;; This simple rule should cover the sanest of the formats | |
| 561 (if (not (re-search-forward "^Received:" lim t)) | |
| 562 (error "This doesn't look like a bounced message.")) | |
| 563 (beginning-of-line) | |
| 564 (setq start (point)))) | |
| 565 ;; briefly nullify vm-mail-header-from to keep vm-mail-internal | |
| 566 ;; from inserting another From header. | |
| 567 (let ((vm-mail-header-from nil)) | |
| 568 (vm-mail-internal | |
| 569 (format "retry of bounce from %s" | |
| 570 (vm-su-from (car vm-message-pointer))))) | |
| 571 (goto-char (point-min)) | |
| 572 (insert-buffer-substring b start lim) | |
| 573 (delete-region (point) (point-max)) | |
| 574 (goto-char (point-min)) | |
| 575 ;; delete all but pertinent headers | |
| 576 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\|Sender:\\)") | |
| 577 (vm-reorder-message-headers nil vm-resend-bounced-headers | |
| 578 vm-resend-bounced-discard-header-regexp) | |
| 579 (if (search-forward "\n\n" nil t) | |
| 580 (replace-match "") | |
| 581 (goto-char (point-max))) | |
| 582 (insert ?\n mail-header-separator ?\n) | |
| 583 (mail-position-on-field "To") | |
| 584 (setq default-directory dir))) | |
| 585 (run-hooks 'vm-resend-bounced-message-hook) | |
| 586 (run-hooks 'vm-mail-mode-hook)) | |
| 587 | |
| 588 (defun vm-resend-message () | |
| 589 "Resend the current message to someone else. | |
| 590 The current message will be copied to a Mail mode buffer and you | |
| 591 can edit the message and send it as usual. | |
| 592 | |
| 593 NOTE: since you are doing a resend, a Resent-To header is | |
| 594 provided for you to fill in. If you don't fill it in, when you | |
| 595 send the message it will go to the original recipients listed in | |
| 596 the To and Cc headers. You may also create a Resent-Cc header." | |
| 597 (interactive) | |
| 598 (vm-follow-summary-cursor) | |
| 599 (vm-select-folder-buffer) | |
| 600 (vm-check-for-killed-summary) | |
| 601 (vm-error-if-folder-empty) | |
| 602 (save-restriction | |
| 603 (widen) | |
| 604 (let ((b (current-buffer)) | |
| 605 (dir default-directory) | |
| 606 (vmp vm-message-pointer) | |
| 607 (start (vm-headers-of (car vm-message-pointer))) | |
| 608 (lim (vm-text-end-of (car vm-message-pointer)))) | |
| 609 ;; briefly nullify vm-mail-header-from to keep vm-mail-internal | |
| 610 ;; from inserting another From header. | |
| 611 (let ((vm-mail-header-from nil)) | |
| 612 (vm-mail-internal | |
| 613 (format "resend of %s's note re: %s" | |
| 614 (vm-su-full-name (car vm-message-pointer)) | |
| 615 (vm-su-subject (car vm-message-pointer))))) | |
| 616 (goto-char (point-min)) | |
| 617 (insert-buffer-substring b start lim) | |
| 618 (delete-region (point) (point-max)) | |
| 619 (goto-char (point-min)) | |
| 620 (if vm-mail-header-from | |
| 621 (insert "Resent-From: " vm-mail-header-from ?\n)) | |
| 622 (insert "Resent-To: \n") | |
| 623 (if mail-self-blind | |
| 624 (insert "Bcc: " (user-login-name) ?\n)) | |
| 625 (if mail-archive-file-name | |
| 626 (insert "FCC: " mail-archive-file-name ?\n)) | |
| 627 ;; delete all but pertinent headers | |
| 628 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\|Sender:\\)") | |
| 629 (vm-reorder-message-headers nil vm-resend-headers | |
| 630 vm-resend-discard-header-regexp) | |
| 631 (if (search-forward "\n\n" nil t) | |
| 632 (replace-match "")) | |
| 633 (insert ?\n mail-header-separator ?\n) | |
| 634 (goto-char (point-min)) | |
| 635 (mail-position-on-field "Resent-To") | |
| 636 (make-local-variable 'vm-redistribute-list) | |
| 637 (setq vm-system-state 'redistributing | |
| 638 vm-redistribute-list (list (car vmp)) | |
| 639 default-directory dir) | |
| 640 (run-hooks 'vm-resend-message-hook) | |
| 641 (run-hooks 'vm-mail-mode-hook)))) | |
| 642 | |
| 643 (defun vm-send-digest (&optional prefix) | |
| 644 "Send a digest of all messages in the current folder to recipients. | |
| 645 The type of the digest is specified by the variable vm-digest-send-type. | |
| 646 You will be placed in a Mail mode buffer as is usual with replies, but you | |
| 647 must fill in the To: and Subject: headers manually. | |
| 648 | |
| 649 Prefix arg means to insert a list of preamble lines at the beginning of | |
| 650 the digest. One line is generated for each message being digestified. | |
| 651 The variable vm-digest-preamble-format determines the format of the | |
| 652 preamble lines. | |
| 653 | |
| 654 If invoked on marked messages (via vm-next-command-uses-marks), | |
| 655 only marked messages will be put into the digest." | |
| 656 (interactive "P") | |
| 657 (vm-select-folder-buffer) | |
| 658 (vm-check-for-killed-summary) | |
| 659 (vm-error-if-folder-empty) | |
| 660 (let ((dir default-directory) | |
| 661 (mp vm-message-pointer) | |
| 662 ;; prefix arg doesn't have "normal" meaning here, so only call | |
| 663 ;; vm-select-marked-or-prefixed-messages if we're using marks. | |
| 664 (mlist (if (eq last-command 'vm-next-command-uses-marks) | |
| 665 (vm-select-marked-or-prefixed-messages 0) | |
| 666 vm-message-list)) | |
| 667 start) | |
| 668 (save-restriction | |
| 669 (widen) | |
| 670 (vm-mail-internal (format "digest from %s" (buffer-name))) | |
| 671 (make-local-variable 'vm-forward-list) | |
| 672 (setq vm-system-state 'forwarding | |
| 673 vm-forward-list mlist | |
| 674 default-directory dir) | |
| 675 (goto-char (point-min)) | |
| 676 (re-search-forward (concat "^" (regexp-quote mail-header-separator) | |
| 677 "\n")) | |
| 678 (goto-char (match-end 0)) | |
| 679 (setq start (point) | |
| 680 mp mlist) | |
| 681 (vm-unsaved-message "Building %s digest..." vm-digest-send-type) | |
| 682 (cond ((equal vm-digest-send-type "rfc934") | |
| 683 (vm-rfc934-encapsulate-messages | |
| 684 mlist vm-rfc934-digest-headers | |
| 685 vm-rfc934-digest-discard-header-regexp)) | |
| 686 ((equal vm-digest-send-type "rfc1153") | |
| 687 (vm-rfc1153-encapsulate-messages | |
| 688 mlist vm-rfc1153-digest-headers | |
| 689 vm-rfc1153-digest-discard-header-regexp))) | |
| 690 (goto-char start) | |
| 691 (setq mp mlist) | |
| 692 (if prefix | |
| 693 (progn | |
| 694 (vm-unsaved-message "Building digest preamble...") | |
| 695 (while mp | |
| 696 (let ((vm-summary-uninteresting-senders nil)) | |
| 697 (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")) | |
| 698 (if vm-digest-center-preamble | |
| 699 (progn | |
| 700 (forward-char -1) | |
| 701 (center-line) | |
| 702 (forward-char 1))) | |
| 703 (setq mp (cdr mp))))) | |
| 704 (mail-position-on-field "To") | |
| 705 (message "Building %s digest... done" vm-digest-send-type))) | |
| 706 (run-hooks 'vm-send-digest-hook) | |
| 707 (run-hooks 'vm-mail-mode-hook)) | |
| 708 | |
| 709 (defun vm-send-rfc934-digest (&optional preamble) | |
| 710 "Like vm-send-digest but always sends an RFC 934 digest." | |
| 711 (interactive "P") | |
| 712 (let ((vm-digest-send-type "rfc934")) | |
| 713 (vm-send-digest preamble))) | |
| 714 | |
| 715 (defun vm-send-rfc1153-digest (&optional preamble) | |
| 716 "Like vm-send-digest but always sends an RFC 1153 digest." | |
| 717 (interactive "P") | |
| 718 (let ((vm-digest-send-type "rfc1153")) | |
| 719 (vm-send-digest preamble))) | |
| 720 | |
| 721 (defun vm-continue-composing-message (&optional not-picky) | |
| 722 "Find and select the most recently used mail composition buffer. | |
| 723 If the selected buffer is already a Mail mode buffer then it is | |
| 724 buried before beginning the search. Non Mail mode buffers and | |
| 725 unmodified Mail buffers are skipped. Prefix arg means unmodified | |
| 726 Mail mode buffers are not skipped. If no suitable buffer is | |
| 727 found, the current buffer remains selected." | |
| 728 (interactive "P") | |
| 729 (if (eq major-mode 'mail-mode) | |
| 730 (vm-bury-buffer (current-buffer))) | |
| 731 (let ((b (vm-find-composition-buffer not-picky))) | |
| 732 (if (not (or (null b) (eq b (current-buffer)))) | |
| 733 (progn | |
| 734 ;; avoid having the window configuration code choose a | |
| 735 ;; different composition buffer. | |
| 736 (vm-unbury-buffer b) | |
| 737 (set-buffer b) | |
| 738 (if (and vm-frame-per-composition (vm-multiple-frames-possible-p) | |
| 739 ;; only pop up a frame if there's an undisplay | |
| 740 ;; hook in place to make the frame go away. | |
| 741 vm-undisplay-buffer-hook) | |
| 742 (let ((w (vm-get-buffer-window b))) | |
| 743 (if (null w) | |
| 744 (vm-goto-new-frame 'composition) | |
| 745 (select-window w) | |
| 746 (and vm-warp-mouse-to-new-frame | |
| 747 (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))) | |
| 748 ;; need to do this here too, since XEmacs has per | |
| 749 ;; frame buffer lists. | |
| 750 (vm-unbury-buffer b) | |
| 751 (vm-set-hooks-for-frame-deletion))) | |
| 752 (vm-display b t '(vm-continue-composing-message) | |
| 753 '(vm-continue-composing-message composing-message))) | |
| 754 (message "No composition buffers found")))) | |
| 755 | |
| 756 ;; to quiet the v19 byte compiler | |
| 757 (defvar mail-mode-map) | |
| 758 (defvar mail-aliases) | |
| 759 (defvar mail-default-reply-to) | |
| 760 (defvar mail-signature-file) | |
| 761 | |
| 762 (defun vm-mail-internal | |
| 763 (&optional buffer-name to subject in-reply-to cc references newsgroups) | |
| 764 (let ((folder-buffer nil)) | |
| 765 (if (memq major-mode '(vm-mode vm-virtual-mode)) | |
| 766 (setq folder-buffer (current-buffer))) | |
| 767 (set-buffer (generate-new-buffer (or buffer-name "*VM-mail*"))) | |
| 768 ;; avoid trying to write auto-save files in potentially | |
| 769 ;; unwritable directories. | |
| 770 (setq default-directory (or vm-folder-directory (expand-file-name "~/"))) | |
| 771 (auto-save-mode (if auto-save-default 1 -1)) | |
| 772 (mail-mode) | |
| 773 (use-local-map vm-mail-mode-map) | |
| 774 ;; make mail-mode-map the parent of this vm-mail-mode-map, if we can. | |
| 775 ;; do it only once. | |
| 776 (if (not vm-mail-mode-map-parented) | |
| 777 (cond ((fboundp 'set-keymap-parents) | |
| 778 (set-keymap-parents vm-mail-mode-map (list mail-mode-map))) | |
| 779 ((consp mail-mode-map) | |
| 780 (nconc vm-mail-mode-map mail-mode-map) | |
| 781 (setq vm-mail-mode-map-parented t)))) | |
| 782 (setq vm-mail-buffer folder-buffer | |
| 783 mode-popup-menu (and vm-use-menus | |
| 784 (vm-menu-support-possible-p) | |
| 785 (vm-menu-mode-menu))) | |
| 786 ;; sets up popup menu for FSF Emacs | |
| 787 (and vm-use-menus (vm-menu-support-possible-p) | |
| 788 (vm-menu-install-mail-mode-menu)) | |
| 789 (if (fboundp 'mail-aliases-setup) ; use mail-abbrevs.el if present | |
| 790 (mail-aliases-setup) | |
| 791 (if (eq mail-aliases t) | |
| 792 (progn | |
| 793 (setq mail-aliases nil) | |
| 794 (if (file-exists-p "~/.mailrc") | |
| 795 (build-mail-aliases))))) | |
| 796 (if (stringp vm-mail-header-from) | |
| 797 (insert "From: " vm-mail-header-from "\n")) | |
| 798 (insert "To: " (or to "") "\n") | |
| 799 (and cc (insert "Cc: " cc "\n")) | |
| 800 (insert "Subject: " (or subject "") "\n") | |
| 801 (and newsgroups (insert "Newsgroups: " newsgroups "\n")) | |
| 802 (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) | |
| 803 (and references (insert "References: " references "\n")) | |
| 804 ;; REPLYTO support for FSF Emacs v19.29 | |
| 805 (and (eq mail-default-reply-to t) | |
| 806 (setq mail-default-reply-to (getenv "REPLYTO"))) | |
| 807 (if mail-default-reply-to | |
| 808 (insert "Reply-To: " mail-default-reply-to "\n")) | |
| 809 (if mail-self-blind | |
| 810 (insert "Bcc: " (user-login-name) "\n")) | |
| 811 (if mail-archive-file-name | |
| 812 (insert "FCC: " mail-archive-file-name "\n")) | |
| 813 (if mail-default-headers | |
| 814 (insert mail-default-headers)) | |
| 815 (if (not (= (preceding-char) ?\n)) | |
| 816 (insert ?\n)) | |
| 817 (insert mail-header-separator "\n") | |
| 818 (cond ((stringp mail-signature) | |
| 819 (save-excursion | |
| 820 (insert mail-signature))) | |
| 821 ((eq mail-signature t) | |
| 822 (save-excursion | |
| 823 (insert "-- \n") | |
| 824 (insert-file-contents (or (and (boundp 'mail-signature-file) | |
| 825 (stringp mail-signature-file) | |
| 826 mail-signature-file) | |
| 827 "~/.signature"))))) | |
| 828 ;; move this buffer to the head of the buffer list so window | |
| 829 ;; config stuff will select it as the composition buffer. | |
| 830 (vm-unbury-buffer (current-buffer)) | |
| 831 ;; make a new frame if the user wants it. | |
| 832 (if (and vm-frame-per-composition (vm-multiple-frames-possible-p)) | |
| 833 (progn | |
| 834 (vm-goto-new-frame 'composition) | |
| 835 (vm-set-hooks-for-frame-deletion))) | |
| 836 ;; now do window configuration | |
| 837 (vm-display (current-buffer) t | |
| 838 '(vm-mail | |
| 839 vm-mail-other-frame | |
| 840 vm-mail-other-window | |
| 841 vm-reply | |
| 842 vm-reply-other-frame | |
| 843 vm-reply-include-text | |
| 844 vm-reply-include-text-other-frame | |
| 845 vm-followup | |
| 846 vm-followup-other-frame | |
| 847 vm-followup-include-text | |
| 848 vm-followup-include-text-other-frame | |
| 849 vm-send-digest | |
| 850 vm-send-digest-other-frame | |
| 851 vm-send-rfc934-digest | |
| 852 vm-send-rfc934-digest-other-frame | |
| 853 vm-send-rfc1153-digest | |
| 854 vm-send-rfc1153-digest-other-frame | |
| 855 vm-forward-message | |
| 856 vm-forward-message-other-frame | |
| 857 vm-forward-message-all-headers | |
| 858 vm-forward-message-all-headers-other-frame | |
| 859 vm-resend-message | |
| 860 vm-resend-message-other-frame | |
| 861 vm-resend-bounced-message | |
| 862 vm-resend-bounced-message-other-frame) | |
| 863 (list this-command 'composing-message)) | |
| 864 (if (null to) | |
| 865 (mail-position-on-field "To")) | |
| 866 (run-hooks 'mail-setup-hook))) | |
| 867 | |
| 868 (defun vm-reply-other-frame (count) | |
| 869 "Like vm-reply, but run in a newly created frame." | |
| 870 (interactive "p") | |
| 871 (if (vm-multiple-frames-possible-p) | |
| 872 (vm-goto-new-frame 'composition)) | |
| 873 (let ((vm-frame-per-composition nil) | |
| 874 (vm-search-other-frames nil)) | |
| 875 (vm-reply count)) | |
| 876 (if (vm-multiple-frames-possible-p) | |
| 877 (vm-set-hooks-for-frame-deletion))) | |
| 878 | |
| 879 (defun vm-reply-include-text-other-frame (count) | |
| 880 "Like vm-reply-include-text, but run in a newly created frame." | |
| 881 (interactive "p") | |
| 882 (if (vm-multiple-frames-possible-p) | |
| 883 (vm-goto-new-frame 'composition)) | |
| 884 (let ((vm-frame-per-composition nil) | |
| 885 (vm-search-other-frames nil)) | |
| 886 (vm-reply-include-text count)) | |
| 887 (if (vm-multiple-frames-possible-p) | |
| 888 (vm-set-hooks-for-frame-deletion))) | |
| 889 | |
| 890 (defun vm-followup-other-frame (count) | |
| 891 "Like vm-followup, but run in a newly created frame." | |
| 892 (interactive "p") | |
| 893 (if (vm-multiple-frames-possible-p) | |
| 894 (vm-goto-new-frame 'composition)) | |
| 895 (let ((vm-frame-per-composition nil) | |
| 896 (vm-search-other-frames nil)) | |
| 897 (vm-followup count)) | |
| 898 (if (vm-multiple-frames-possible-p) | |
| 899 (vm-set-hooks-for-frame-deletion))) | |
| 900 | |
| 901 (defun vm-followup-include-text-other-frame (count) | |
| 902 "Like vm-followup-include-text, but run in a newly created frame." | |
| 903 (interactive "p") | |
| 904 (if (vm-multiple-frames-possible-p) | |
| 905 (vm-goto-new-frame 'composition)) | |
| 906 (let ((vm-frame-per-composition nil) | |
| 907 (vm-search-other-frames nil)) | |
| 908 (vm-followup-include-text count)) | |
| 909 (if (vm-multiple-frames-possible-p) | |
| 910 (vm-set-hooks-for-frame-deletion))) | |
| 911 | |
| 912 (defun vm-forward-message-all-headers-other-frame () | |
| 913 "Like vm-forward-message-all-headers, but run in a newly created frame." | |
| 914 (interactive) | |
| 915 (if (vm-multiple-frames-possible-p) | |
| 916 (vm-goto-new-frame 'composition)) | |
| 917 (let ((vm-frame-per-composition nil) | |
| 918 (vm-search-other-frames nil)) | |
| 919 (vm-forward-message-all-headers)) | |
| 920 (if (vm-multiple-frames-possible-p) | |
| 921 (vm-set-hooks-for-frame-deletion))) | |
| 922 | |
| 923 (defun vm-forward-message-other-frame () | |
| 924 "Like vm-forward-message, but run in a newly created frame." | |
| 925 (interactive) | |
| 926 (if (vm-multiple-frames-possible-p) | |
| 927 (vm-goto-new-frame 'composition)) | |
| 928 (let ((vm-frame-per-composition nil) | |
| 929 (vm-search-other-frames nil)) | |
| 930 (vm-forward-message)) | |
| 931 (if (vm-multiple-frames-possible-p) | |
| 932 (vm-set-hooks-for-frame-deletion))) | |
| 933 | |
| 934 (defun vm-resend-message-other-frame () | |
| 935 "Like vm-resend-message, but run in a newly created frame." | |
| 936 (interactive) | |
| 937 (if (vm-multiple-frames-possible-p) | |
| 938 (vm-goto-new-frame 'composition)) | |
| 939 (let ((vm-frame-per-composition nil) | |
| 940 (vm-search-other-frames nil)) | |
| 941 (vm-resend-message)) | |
| 942 (if (vm-multiple-frames-possible-p) | |
| 943 (vm-set-hooks-for-frame-deletion))) | |
| 944 | |
| 945 (defun vm-resend-bounced-message-other-frame () | |
| 946 "Like vm-resend-bounced-message, but run in a newly created frame." | |
| 947 (interactive) | |
| 948 (if (vm-multiple-frames-possible-p) | |
| 949 (vm-goto-new-frame 'composition)) | |
| 950 (let ((vm-frame-per-composition nil) | |
| 951 (vm-search-other-frames nil)) | |
| 952 (vm-resend-bounced-message)) | |
| 953 (if (vm-multiple-frames-possible-p) | |
| 954 (vm-set-hooks-for-frame-deletion))) | |
| 955 | |
| 956 (defun vm-send-digest-other-frame (&optional prefix) | |
| 957 "Like vm-send-digest, but run in a newly created frame." | |
| 958 (interactive "P") | |
| 959 (if (vm-multiple-frames-possible-p) | |
| 960 (vm-goto-new-frame 'composition)) | |
| 961 (let ((vm-frame-per-composition nil) | |
| 962 (vm-search-other-frames nil)) | |
| 963 (vm-send-digest prefix)) | |
| 964 (if (vm-multiple-frames-possible-p) | |
| 965 (vm-set-hooks-for-frame-deletion))) | |
| 966 | |
| 967 (defun vm-send-rfc934-digest-other-frame (&optional prefix) | |
| 968 "Like vm-send-rfc934-digest, but run in a newly created frame." | |
| 969 (interactive "P") | |
| 970 (if (vm-multiple-frames-possible-p) | |
| 971 (vm-goto-new-frame 'composition)) | |
| 972 (let ((vm-frame-per-composition nil) | |
| 973 (vm-search-other-frames nil)) | |
| 974 (vm-send-rfc934-digest prefix)) | |
| 975 (if (vm-multiple-frames-possible-p) | |
| 976 (vm-set-hooks-for-frame-deletion))) | |
| 977 | |
| 978 (defun vm-send-rfc1153-digest-other-frame (&optional prefix) | |
| 979 "Like vm-send-rfc1153-digest, but run in a newly created frame." | |
| 980 (interactive "P") | |
| 981 (if (vm-multiple-frames-possible-p) | |
| 982 (vm-goto-new-frame 'composition)) | |
| 983 (let ((vm-frame-per-composition nil) | |
| 984 (vm-search-other-frames nil)) | |
| 985 (vm-send-rfc1153-digest prefix)) | |
| 986 (if (vm-multiple-frames-possible-p) | |
| 987 (vm-set-hooks-for-frame-deletion))) |