comparison lisp/vm/vm-reply.el @ 136:b980b6286996 r20-2b2

Import from CVS: tag r20-2b2
author cvs
date Mon, 13 Aug 2007 09:31:12 +0200
parents 1370575f1259
children 585fb297b004
comparison
equal deleted inserted replaced
135:4636a6841cd6 136:b980b6286996
342 (interactive "P") 342 (interactive "P")
343 (vm-check-for-killed-folder) 343 (vm-check-for-killed-folder)
344 (let ((b (current-buffer))) 344 (let ((b (current-buffer)))
345 (vm-mail-send) 345 (vm-mail-send)
346 (cond ((null (buffer-name b)) ;; dead buffer 346 (cond ((null (buffer-name b)) ;; dead buffer
347 ;; This improves window configuration behavior in
348 ;; XEmacs. It avoids taking the folder buffer from
349 ;; one frame and attaching it to the selected frame.
350 (set-buffer (window-buffer (selected-window)))
347 (vm-display nil nil '(vm-mail-send-and-exit) 351 (vm-display nil nil '(vm-mail-send-and-exit)
348 '(vm-mail-send-and-exit 352 '(vm-mail-send-and-exit
349 reading-message 353 reading-message
350 startup))) 354 startup)))
351 (t 355 (t
438 (vm-mail-mark-replied)) 442 (vm-mail-mark-replied))
439 ((eq vm-system-state 'forwarding) 443 ((eq vm-system-state 'forwarding)
440 (vm-mail-mark-forwarded)) 444 (vm-mail-mark-forwarded))
441 ((eq vm-system-state 'redistributing) 445 ((eq vm-system-state 'redistributing)
442 (vm-mail-mark-redistributed))) 446 (vm-mail-mark-redistributed)))
447 (vm-display nil nil '(vm-mail-send) '(vm-mail-send))
443 ;; be careful, something could have killed the composition 448 ;; be careful, something could have killed the composition
444 ;; buffer inside mail-send. 449 ;; buffer inside mail-send.
445 (if (eq (current-buffer) composition-buffer) 450 (if (eq (current-buffer) composition-buffer)
446 (progn 451 (progn
447 (vm-rename-current-mail-buffer) 452 (vm-rename-current-mail-buffer)
448 (vm-keep-mail-buffer (current-buffer)))) 453 (vm-keep-mail-buffer (current-buffer))))))
449 (vm-display nil nil '(vm-mail-send) '(vm-mail-send))))
450 454
451 (defun vm-mail-mode-get-header-contents (header-name-regexp) 455 (defun vm-mail-mode-get-header-contents (header-name-regexp)
452 (let ((contents nil) 456 (let ((contents nil)
453 regexp) 457 regexp)
454 (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^" 458 (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^"
610 (interactive) 614 (interactive)
611 (vm-follow-summary-cursor) 615 (vm-follow-summary-cursor)
612 (vm-select-folder-buffer) 616 (vm-select-folder-buffer)
613 (vm-check-for-killed-summary) 617 (vm-check-for-killed-summary)
614 (vm-error-if-folder-empty) 618 (vm-error-if-folder-empty)
615 (if (eq last-command 'vm-next-command-uses-marks) 619 (if (and (eq last-command 'vm-next-command-uses-marks)
620 (cdr (vm-select-marked-or-prefixed-messages 0)))
616 (let ((vm-digest-send-type vm-forwarding-digest-type)) 621 (let ((vm-digest-send-type vm-forwarding-digest-type))
617 (setq this-command 'vm-next-command-uses-marks) 622 (setq this-command 'vm-next-command-uses-marks)
618 (command-execute 'vm-send-digest)) 623 (command-execute 'vm-send-digest))
619 (let ((dir default-directory) 624 (let ((dir default-directory)
620 (miming (and vm-send-using-mime 625 (miming (and vm-send-using-mime
621 (equal vm-forwarding-digest-type "mime"))) 626 (equal vm-forwarding-digest-type "mime")))
622 mail-buffer 627 mail-buffer
623 header-end boundary 628 header-end
624 (mp vm-message-pointer)) 629 (mp (vm-select-marked-or-prefixed-messages 1)))
625 (save-restriction 630 (save-restriction
626 (widen) 631 (widen)
627 (vm-mail-internal 632 (vm-mail-internal
628 (format "forward of %s's note re: %s" 633 (format "forward of %s's note re: %s"
629 (vm-su-full-name (car vm-message-pointer)) 634 (vm-su-full-name (car vm-message-pointer))
646 (re-search-forward (concat "^" (regexp-quote mail-header-separator) 651 (re-search-forward (concat "^" (regexp-quote mail-header-separator)
647 "\n")) 652 "\n"))
648 (goto-char (match-end 0)) 653 (goto-char (match-end 0))
649 (setq header-end (match-beginning 0))) 654 (setq header-end (match-beginning 0)))
650 (cond ((equal vm-forwarding-digest-type "mime") 655 (cond ((equal vm-forwarding-digest-type "mime")
651 (setq boundary (vm-mime-encapsulate-messages 656 (vm-mime-encapsulate-messages (list (car mp))
652 (list (car mp)) vm-forwarded-headers 657 vm-forwarded-headers
653 vm-unforwarded-header-regexp)) 658 vm-unforwarded-header-regexp
659 nil)
654 (goto-char header-end) 660 (goto-char header-end)
655 (insert "MIME-Version: 1.0\n") 661 (insert "MIME-Version: 1.0\n")
656 (insert (if vm-mime-avoid-folding-content-type 662 (insert "Content-Type: message/rfc822\n")
657 "Content-Type: multipart/digest; boundary=\""
658 "Content-Type: multipart/digest;\n\tboundary=\"")
659 boundary "\"\n")
660 (insert "Content-Transfer-Encoding: " 663 (insert "Content-Transfer-Encoding: "
661 (vm-determine-proper-content-transfer-encoding 664 (vm-determine-proper-content-transfer-encoding
662 (point) 665 (point)
663 (point-max)) 666 (point-max))
664 "\n")) 667 "\n"))
676 vm-unforwarded-header-regexp))) 679 vm-unforwarded-header-regexp)))
677 (if miming 680 (if miming
678 (let ((b (current-buffer))) 681 (let ((b (current-buffer)))
679 (set-buffer mail-buffer) 682 (set-buffer mail-buffer)
680 (mail-text) 683 (mail-text)
681 (vm-mime-attach-object b "multipart/digest" 684 (vm-mime-attach-object b "message/rfc822" nil nil t)
682 (list (concat "boundary=\""
683 boundary "\"")) nil t)
684 (add-hook 'kill-buffer-hook 685 (add-hook 'kill-buffer-hook
685 (list 'lambda () 686 (list 'lambda ()
686 (list 'if (list 'eq mail-buffer '(current-buffer)) 687 (list 'if (list 'eq mail-buffer '(current-buffer))
687 (list 'kill-buffer b)))))) 688 (list 'kill-buffer b))))))
688 (mail-position-on-field "To")) 689 (mail-position-on-field "To"))
753 (defun vm-resend-message () 754 (defun vm-resend-message ()
754 "Resend the current message to someone else. 755 "Resend the current message to someone else.
755 The current message will be copied to a Mail mode buffer and you 756 The current message will be copied to a Mail mode buffer and you
756 can edit the message and send it as usual. 757 can edit the message and send it as usual.
757 758
758 NOTE: since you are doing a resend, a Resent-To header is 759 NOTE: since you are doing a resend, a Resent-To header is provided
759 provided for you to fill in. If you don't fill it in, when you 760 for you to fill in the new recipient list. If you don't fill in
760 send the message it will go to the original recipients listed in 761 this header, what happens when you send the message is undefined.
761 the To and Cc headers. You may also create a Resent-Cc header." 762 You may also create a Resent-Cc header."
762 (interactive) 763 (interactive)
763 (vm-follow-summary-cursor) 764 (vm-follow-summary-cursor)
764 (vm-select-folder-buffer) 765 (vm-select-folder-buffer)
765 (vm-check-for-killed-summary) 766 (vm-check-for-killed-summary)
766 (vm-error-if-folder-empty) 767 (vm-error-if-folder-empty)
853 header-end (match-beginning 0))) 854 header-end (match-beginning 0)))
854 (message "Building %s digest..." vm-digest-send-type) 855 (message "Building %s digest..." vm-digest-send-type)
855 (cond ((equal vm-digest-send-type "mime") 856 (cond ((equal vm-digest-send-type "mime")
856 (setq boundary (vm-mime-encapsulate-messages 857 (setq boundary (vm-mime-encapsulate-messages
857 mlist vm-mime-digest-headers 858 mlist vm-mime-digest-headers
858 vm-mime-digest-discard-header-regexp)) 859 vm-mime-digest-discard-header-regexp
860 t))
859 (goto-char header-end) 861 (goto-char header-end)
860 (insert "MIME-Version: 1.0\n") 862 (insert "MIME-Version: 1.0\n")
861 (insert (if vm-mime-avoid-folding-content-type 863 (insert (if vm-mime-avoid-folding-content-type
862 "Content-Type: multipart/digest; boundary=\"" 864 "Content-Type: multipart/digest; boundary=\""
863 "Content-Type: multipart/digest;\n\tboundary=\"") 865 "Content-Type: multipart/digest;\n\tboundary=\"")
875 (vm-rfc1153-encapsulate-messages 877 (vm-rfc1153-encapsulate-messages
876 mlist vm-rfc1153-digest-headers 878 mlist vm-rfc1153-digest-headers
877 vm-rfc1153-digest-discard-header-regexp))) 879 vm-rfc1153-digest-discard-header-regexp)))
878 (goto-char start) 880 (goto-char start)
879 (setq mp mlist) 881 (setq mp mlist)
880 (if prefix
881 (progn
882 (message "Building digest preamble...")
883 (while mp
884 (let ((vm-summary-uninteresting-senders nil))
885 (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
886 (if vm-digest-center-preamble
887 (progn
888 (forward-char -1)
889 (center-line)
890 (forward-char 1)))
891 (setq mp (cdr mp)))))
892 (if miming 882 (if miming
893 (let ((b (current-buffer))) 883 (let ((b (current-buffer)))
894 (set-buffer mail-buffer) 884 (set-buffer mail-buffer)
895 (mail-text) 885 (mail-text)
896 (vm-mime-attach-object b "multipart/digest" 886 (vm-mime-attach-object b "multipart/digest"
898 boundary "\"")) nil t) 888 boundary "\"")) nil t)
899 (add-hook 'kill-buffer-hook 889 (add-hook 'kill-buffer-hook
900 (list 'lambda () 890 (list 'lambda ()
901 (list 'if (list 'eq mail-buffer '(current-buffer)) 891 (list 'if (list 'eq mail-buffer '(current-buffer))
902 (list 'kill-buffer b)))))) 892 (list 'kill-buffer b))))))
893 (if prefix
894 (save-excursion
895 (message "Building digest preamble...")
896 (if miming
897 (progn
898 (set-buffer mail-buffer)
899 (mail-text)))
900 (while mp
901 (let ((vm-summary-uninteresting-senders nil))
902 (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
903 (if vm-digest-center-preamble
904 (progn
905 (forward-char -1)
906 (center-line)
907 (forward-char 1)))
908 (setq mp (cdr mp)))))
903 (mail-position-on-field "To") 909 (mail-position-on-field "To")
904 (message "Building %s digest... done" vm-digest-send-type))) 910 (message "Building %s digest... done" vm-digest-send-type)))
905 (run-hooks 'vm-send-digest-hook) 911 (run-hooks 'vm-send-digest-hook)
906 (run-hooks 'vm-mail-mode-hook)) 912 (run-hooks 'vm-mail-mode-hook))
907 913