xemacs-beta: lisp/vm/vm-reply.el comparison

comparison lisp/vm/vm-reply.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	05472e90ae02
children	c0c698873ce1

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; Mailing, forwarding, and replying commands for VM
-;;; Copyright (C) 1989-1997 Kyle E. Jones
+;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 ;;; the Free Software Foundation; either version 1, or (at your option)
 ;;; any later version.
 (while mp
 	(cond
 	 ((eq mlist mp)
 	  (cond ((setq to
 		       (let ((reply-to
-			      (vm-get-header-contents (car mp) "Reply-To:"
+			      (vm-get-header-contents (car mp) "Reply-To:")))
-						      ", ")))
 			 (if (vm-ignored-reply-to reply-to)
 			     nil
 			   reply-to ))))
-		((setq to (vm-get-header-contents (car mp) "From:" ", ")))
+		((setq to (vm-get-header-contents (car mp) "From:")))
 		;; bad, but better than nothing for some
 		((setq to (vm-grok-From_-author (car mp))))
 		(t (error "No From: or Reply-To: header in message")))
 	  (setq subject (vm-get-header-contents (car mp) "Subject:")
 		in-reply-to
 		  (equal
 		   (string-match (regexp-quote vm-reply-subject-prefix)
 				 subject)
 		   0)))
 	       (setq subject (concat vm-reply-subject-prefix subject))))
-	 (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:"
+	 (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:"))
-						     ", "))
 		   (setq to (concat to "," tmp)))
-		  ((setq tmp (vm-get-header-contents (car mp) "From:"
+		  ((setq tmp (vm-get-header-contents (car mp) "From:"))
-						     ", "))
 		   (setq to (concat to "," tmp)))
 		  ;; bad, but better than nothing for some
 		  ((setq tmp (vm-grok-From_-author (car mp)))
 		   (setq to (concat to "," tmp)))
 		  (t (error "No From: or Reply-To: header in message")))))
 	(if to-all
 	    (progn
-	      (setq tmp (vm-get-header-contents (car mp) "To:"
+	      (setq tmp (vm-get-header-contents (car mp) "To:"))
-						", "))
+	      (setq tmp2 (vm-get-header-contents (car mp) "Cc:"))
-	      (setq tmp2 (vm-get-header-contents (car mp) "Cc:"
-						 ", "))
 	      (if tmp
 		  (if cc
 		      (setq cc (concat cc "," tmp))
 		    (setq cc tmp)))
 	      (if tmp2
 		  (if cc
 		      (setq cc (concat cc "," tmp2))
 		    (setq cc tmp2)))))
 	(setq references
-	      (cons (vm-get-header-contents (car mp) "References:" " ")
+	      (cons (vm-get-header-contents (car mp) "References:")
-		    (cons (vm-get-header-contents (car mp) "In-reply-to:" " ")
+		    (cons (vm-get-header-contents (car mp) "In-reply-to:")
-			  (cons (vm-get-header-contents (car mp) "Message-ID:"
+			  (cons (vm-get-header-contents (car mp) "Message-ID:")
-							" ")
 				references))))
 	(setq newsgroups
-	      (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:" ","))
+	      (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To:"))
-			(vm-get-header-contents (car mp) "Newsgroups:" ","))
+			(vm-get-header-contents (car mp) "Newsgroups:"))
 		    newsgroups))
 	(setq mp (cdr mp)))
 (if vm-strip-reply-headers
 	  (let ((mail-use-rfc822 t))
 	    (and to (setq to (mail-strip-quoted-names to)))
 	    (let ((case-fold-search nil))
 	      (re-search-forward
 	       (concat "^" (regexp-quote mail-header-separator) "$") nil 0))
 	    (forward-char 1)
 	    (while mlist
-	      (save-restriction
+	      (vm-yank-message (car mlist))
-		(narrow-to-region (point) (point))
+	      (goto-char (point-max))
-		(vm-yank-message (car mlist))
-		(goto-char (point-max)))
 	      (setq mlist (cdr mlist)))))
 (run-hooks 'vm-reply-hook)
 (run-hooks 'vm-mail-mode-hook)))
 (defun vm-strip-ignored-addresses (addresses)
 (let ((b (current-buffer)) newbuf sumbuf default result prompt mp)
 (set-buffer (or (vm-get-file-buffer folder) (find-file-noselect folder)))
 (setq newbuf (current-buffer))
 (if (not (eq major-mode 'vm-mode))
 	(vm-mode))
-(if vm-presentation-buffer-handle
-	(vm-bury-buffer vm-presentation-buffer-handle))
 (if (null vm-message-pointer)
 	(error "No messages in folder %s" folder))
 (setq default (vm-number-of (car vm-message-pointer)))
 (save-excursion
 (save-window-excursion
 (setq message (vm-real-message-of message))
 (let ((b (current-buffer)) (start (point)) end)
 (save-restriction
 (widen)
 (save-excursion
-	(if (vectorp (vm-mm-layout message))
+	(set-buffer (vm-buffer-of message))
-	    (let* ((o (vm-mm-layout message))
+	(save-restriction
-		   (type (car (vm-mm-layout-type o)))
+	  (widen)
-		   parts)
+	  (append-to-buffer b (vm-headers-of message) (vm-text-end-of message))
-	      (vm-insert-region-from-buffer (vm-buffer-of message)
+	  (setq end (vm-marker (+ start (- (vm-text-end-of message)
-					    (vm-headers-of message)
+					   (vm-headers-of message))) b))))
-					    (vm-text-of message))
-	      (cond ((vm-mime-types-match "multipart" type)
-		     (setq parts (copy-sequence (vm-mm-layout-parts o))))
-		    (t (setq parts (list o))))
-	      (while parts
-		(cond ((vm-mime-text-type-p (car parts))
-		       (if (cond ((vm-mime-types-match
-				   "text/html"
-				   (car (vm-mm-layout-type (car parts))))
-				  (vm-mime-display-internal-text/html
-				   (car parts)))
-				 ((vm-mime-types-match
-				   "text/enriched"
-				   (car (vm-mm-layout-type (car parts))))
-				  (vm-mime-display-internal-text/enriched
-				   (car parts)))
-				 ((vm-mime-display-internal-text/plain
-				   (car parts) t)))
-			   nil
-			 ;; charset problems probably
-			 ;; just dump the raw bits
-			 (vm-mime-insert-mime-body (car parts))
-			 (vm-mime-transfer-decode-region (car parts)
-							 start (point)))
-		       (setq parts (cdr parts)))
-		      ((vm-mime-composite-type-p
-			(car (vm-mm-layout-type (car parts))))
-		       (setq parts (nconc (copy-sequence
-					   (vm-mm-layout-parts
-					    (car parts)))
-					  (cdr parts))))
-		      (t (setq parts (cdr parts)))))
-	      (setq end (point-marker)))
-	  (set-buffer (vm-buffer-of message))
-	  (save-restriction
-	    (widen)
-	    (append-to-buffer b (vm-headers-of message)
-			      (vm-text-end-of message))
-	    (setq end (vm-marker (+ start (- (vm-text-end-of message)
-					     (vm-headers-of message))) b)))))
 (push-mark end)
 (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
 	    (mail-yank-hooks (run-hooks 'mail-yank-hooks))
 	    (t (vm-mail-yank-default message))))))
 (defun vm-mail-send-and-exit (arg)
 "Just like mail-send-and-exit except that VM flags the appropriate message(s)
 as having been replied to, if appropriate."
 (interactive "P")
-(vm-check-for-killed-folder)
 (let ((b (current-buffer)))
 (vm-mail-send)
 (cond ((null (buffer-name b)) ;; dead buffer
-	   ;; This improves window configuration behavior in
-	   ;; XEmacs.  It avoids taking the folder buffer from
-	   ;; one frame and attaching it to the selected frame.
-	   (set-buffer (window-buffer (selected-window)))
 	   (vm-display nil nil '(vm-mail-send-and-exit)
-		       '(vm-mail-send-and-exit
+		       '(vm-mail-send-and-exit reading-message startup)))
-			 reading-message
-			 startup)))
 	  (t
 	   (vm-display b nil '(vm-mail-send-and-exit)
 		       '(vm-mail-send-and-exit reading-message startup))
 	   (vm-bury-buffer b)))))
 (if (not (eq vm-keep-sent-messages t))
 (let ((extras (nthcdr (or vm-keep-sent-messages 0)
 				vm-kept-mail-buffers)))
 	(mapcar (function
 		 (lambda (b)
-		   (and (buffer-name b)
+		   (and (buffer-name b) (kill-buffer b))))
-			(not (buffer-modified-p b))
-			(kill-buffer b))))
 		extras)
 	(and vm-kept-mail-buffers extras
 	     (setcdr (memq (car extras) vm-kept-mail-buffers) nil)))))
 (defun vm-help-tale ()
 "Just like mail-send except that VM flags the appropriate message(s)
 as replied to, forwarded, etc, if appropriate."
 (interactive)
 (if vm-tale-is-an-idiot
 (vm-help-tale))
-;; protect value of this-command from minibuffer read
+(if (and vm-confirm-mail-send
-(let ((this-command this-command))
+	   (not (y-or-n-p "Send the message? ")))
-(if (and vm-confirm-mail-send
+(error "Message not sent."))
-	     (not (y-or-n-p "Send the message? ")))
-	(error "Message not sent.")))
-;; send mail using MIME if user requests it and if the buffer
-;; has not already been MIME encoded.
-(if (and vm-send-using-mime
-	   (null (vm-mail-mode-get-header-contents "MIME-Version:")))
-(vm-mime-encode-composition))
 ;; this to prevent Emacs 19 from asking whether a message that
 ;; has already been sent should be sent again.  VM renames mail
 ;; buffers after the message has been sent, so the user should
 ;; already know that the message has been sent.
 (set-buffer-modified-p t)
-(let ((composition-buffer (current-buffer))
+;; don't want a buffer change to occur here
-	;; preserve these in case the composition buffer gets
+;; save-excursion to be sure.
-	;; killed.
+(save-excursion
-	(vm-reply-list vm-reply-list)
+(mail-send))
-	(vm-forward-list vm-forward-list)
+(vm-rename-current-mail-buffer)
-	(vm-redistribute-list vm-redistribute-list))
+(cond ((eq vm-system-state 'replying)
-;; fragment message using message/partial if it is too big.
+	 (vm-mail-mark-replied))
-(if (and vm-send-using-mime
+	((eq vm-system-state 'forwarding)
-	     (integerp vm-mime-max-message-size)
+	 (vm-mail-mark-forwarded))
-	     (> (buffer-size) vm-mime-max-message-size))
+	((eq vm-system-state 'redistributing)
-	(let (list)
+	 (vm-mail-mark-redistributed)))
-	  (setq list (vm-mime-fragment-composition vm-mime-max-message-size))
+(vm-keep-mail-buffer (current-buffer))
-	  (while list
+(vm-display nil nil '(vm-mail-send) '(vm-mail-send)))
-	    (save-excursion
-	      (set-buffer (car list))
-	      (vm-mail-send)
-	      (kill-buffer (car list)))
-	    (setq list (cdr list)))
-	  ;; what mail-send would have done
-	  (set-buffer-modified-p nil))
-;; don't want a buffer change to occur here
-;; save-excursion to be sure.
-;;
-;; also protect value of this-command from minibuffer reads
-(let ((this-command this-command))
-	(save-excursion
-	  (mail-send))))
-;; be careful, something could have killed the composition
-;; buffer inside mail-send.
-(if (eq (current-buffer) composition-buffer)
-	(progn
-	  (cond ((eq vm-system-state 'replying)
-		 (vm-mail-mark-replied))
-		((eq vm-system-state 'forwarding)
-		 (vm-mail-mark-forwarded))
-		((eq vm-system-state 'redistributing)
-		 (vm-mail-mark-redistributed)))
-	  (vm-rename-current-mail-buffer)
-	  (vm-keep-mail-buffer (current-buffer))))
-(vm-display nil nil '(vm-mail-send) '(vm-mail-send))))
-(defun vm-mail-mode-get-header-contents (header-name-regexp)
-(let ((contents nil)
-	regexp)
-(setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^"
-			 (regexp-quote mail-header-separator) "$\\)"))
-(save-excursion
-(save-restriction
-	(widen)
-	(goto-char (point-min))
-	(let ((case-fold-search t))
-	  (if (and (re-search-forward regexp nil t)
-		   (match-beginning 1)
-		   (progn (goto-char (match-beginning 0))
-			  (vm-match-header)))
-	      (vm-matched-header-contents)
-	    nil ))))))
 (defun vm-rename-current-mail-buffer ()
 (if vm-rename-current-buffer-function
 (funcall vm-rename-current-buffer-function)
 (let ((case-fold-search nil))
 (defun vm-forward-message-all-headers ()
 "Like vm-forward-message but always forwards all the headers."
 (interactive)
 (let ((vm-forwarded-headers nil)
-	(vm-unforwarded-header-regexp "only-drop-this-header")
+	(vm-unforwarded-header-regexp "only-drop-this-header"))
-	;; set these because vm-forward-message calls vm-send-digest
-	;; if there is more than one message to be forwarded.
-	(vm-rfc934-digest-headers nil)
-	(vm-rfc934-digest-discard-header-regexp "only-drop-this-header")
-	(vm-rfc1153-digest-headers nil)
-	(vm-rfc1153-digest-discard-header-regexp "only-drop-this-header")
-	(vm-mime-digest-headers nil)
-	(vm-mime-digest-discard-header-regexp "only-drop-this-header"))
 (vm-forward-message)))
 (defun vm-forward-message ()
 "Forward the current message to one or more recipients.
 You will be placed in a Mail mode buffer as you would with a
 (interactive)
 (vm-follow-summary-cursor)
 (vm-select-folder-buffer)
 (vm-check-for-killed-summary)
 (vm-error-if-folder-empty)
-(if (and (eq last-command 'vm-next-command-uses-marks)
+(if (eq last-command 'vm-next-command-uses-marks)
-	   (cdr (vm-select-marked-or-prefixed-messages 0)))
 (let ((vm-digest-send-type vm-forwarding-digest-type))
 	(setq this-command 'vm-next-command-uses-marks)
 	(command-execute 'vm-send-digest))
 (let ((dir default-directory)
-	  (miming (and vm-send-using-mime
+	  (mp vm-message-pointer))
-		       (equal vm-forwarding-digest-type "mime")))
-	  mail-buffer
-	  header-end
-	  (mp (vm-select-marked-or-prefixed-messages 1)))
 (save-restriction
 	(widen)
 	(vm-mail-internal
 	 (format "forward of %s's note re: %s"
 		 (vm-su-full-name (car vm-message-pointer))
 		(vm-sprintf 'vm-forwarding-subject-format (car mp)))))
 	(make-local-variable 'vm-forward-list)
 	(setq vm-system-state 'forwarding
 	      vm-forward-list (list (car mp))
 	      default-directory dir)
-	(if miming
+	(goto-char (point-min))
-	    (progn
+	(re-search-forward
-	      (setq mail-buffer (current-buffer))
+	 (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
-	      (set-buffer (generate-new-buffer "*vm-forward-buffer*"))
+	(cond ((equal vm-forwarding-digest-type "rfc934")
-	      (setq header-end (point))
-	      (insert "\n"))
-	  (goto-char (point-min))
-	  (re-search-forward (concat "^" (regexp-quote mail-header-separator)
-				     "\n"))
-	  (goto-char (match-end 0))
-	  (setq header-end (match-beginning 0)))
-	(cond ((equal vm-forwarding-digest-type "mime")
-	       (vm-mime-encapsulate-messages (list (car mp))
-					     vm-forwarded-headers
-					     vm-unforwarded-header-regexp
-					     nil)
-	       (goto-char header-end)
-	       (insert "MIME-Version: 1.0\n")
-	       (insert "Content-Type: message/rfc822\n")
-	       (insert "Content-Transfer-Encoding: "
-		       (vm-determine-proper-content-transfer-encoding
-			(point)
-			(point-max))
-		       "\n"))
-	      ((equal vm-forwarding-digest-type "rfc934")
 	       (vm-rfc934-encapsulate-messages
 		vm-forward-list vm-forwarded-headers
 		vm-unforwarded-header-regexp))
 	      ((equal vm-forwarding-digest-type "rfc1153")
 	       (vm-rfc1153-encapsulate-messages
 		vm-forward-list vm-forwarded-headers
 		vm-unforwarded-header-regexp))
+	      ((equal vm-forwarding-digest-type "rfc1521")
+	       (vm-rfc1521-encapsulate-messages
+		vm-forward-list vm-forwarded-headers
+		vm-unforwarded-header-regexp))
 	      ((equal vm-forwarding-digest-type nil)
 	       (vm-no-frills-encapsulate-message
 		(car vm-forward-list) vm-forwarded-headers
 		vm-unforwarded-header-regexp)))
-(if miming
-	  (let ((b (current-buffer)))
-	    (set-buffer mail-buffer)
-	    (mail-text)
-	    (vm-mime-attach-object b "message/rfc822" nil nil t)
-	    (add-hook 'kill-buffer-hook
-		      (list 'lambda ()
-			    (list 'if (list 'eq mail-buffer '(current-buffer))
-				  (list 'kill-buffer b))))))
 	(mail-position-on-field "To"))
 (run-hooks 'vm-forward-message-hook)
 (run-hooks 'vm-mail-mode-hook))))
 (defun vm-resend-bounced-message ()
 (vm-select-folder-buffer)
 (vm-check-for-killed-summary)
 (vm-error-if-folder-empty)
 (let ((b (current-buffer)) start
 	(dir default-directory)
-	(layout (vm-mm-layout (car vm-message-pointer)))
 	(lim (vm-text-end-of (car vm-message-pointer))))
 (save-restriction
 	(widen)
-	(if (or (not (vectorp layout))
+	(save-excursion
-		(not (setq layout (vm-mime-layout-contains-type
+	  (goto-char (vm-text-of (car vm-message-pointer)))
-				   layout "message/rfc822"))))
+	  (let ((case-fold-search t))
-	    (save-excursion
+	    ;; What a wonderful world it would be if mailers used a single
-	      (goto-char (vm-text-of (car vm-message-pointer)))
+	    ;; message encapsulation standard instead all the weird variants
-	      (let ((case-fold-search t))
+	    ;; It is useless to try to cover them all.
-		;; What a wonderful world it would be if mailers
+	    ;; This simple rule should cover the sanest of the formats
-		;; used a single message encapsulation standard
+	    (if (not (re-search-forward "^Received:" lim t))
-		;; instead of all the weird variants. It is
+		(error "This doesn't look like a bounced message."))
-		;; useless to try to cover them all.  This simple
+	    (beginning-of-line)
-		;; rule should cover the sanest of the formats
+	    (setq start (point))))
-		(if (not (re-search-forward "^Received:" lim t))
-		    (error "This doesn't look like a bounced message."))
-		(beginning-of-line)
-		(setq start (point)))))
 	;; briefly nullify vm-mail-header-from to keep vm-mail-internal
 	;; from inserting another From header.
 	(let ((vm-mail-header-from nil))
 	  (vm-mail-internal
 	   (format "retry of bounce from %s"
 		   (vm-su-from (car vm-message-pointer)))))
 	(goto-char (point-min))
-	(if (vectorp layout)
+	(insert-buffer-substring b start lim)
-	    (progn
-	      (setq start (point))
-	      (vm-mime-insert-mime-body layout)
-	      (vm-mime-transfer-decode-region layout start (point)))
-	  (insert-buffer-substring b start lim))
 	(delete-region (point) (point-max))
 	(goto-char (point-min))
 	;; delete all but pertinent headers
 	(vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\|Sender:\\)")
 	(vm-reorder-message-headers nil vm-resend-bounced-headers
 				    vm-resend-bounced-discard-header-regexp)
 	(if (search-forward "\n\n" nil t)
 	    (replace-match "")
 	  (goto-char (point-max)))
 	(insert ?\n mail-header-separator ?\n)
-	(goto-char (point-min))
+	(mail-position-on-field "To")
-	(if vm-mail-header-from
-	    (insert "Resent-From: " vm-mail-header-from ?\n))
-	(mail-position-on-field "Resent-To")
 	(setq default-directory dir)))
 (run-hooks 'vm-resend-bounced-message-hook)
 (run-hooks 'vm-mail-mode-hook))
 (defun vm-resend-message ()
 "Resend the current message to someone else.
 The current message will be copied to a Mail mode buffer and you
 can edit the message and send it as usual.
-NOTE: since you are doing a resend, a Resent-To header is provided
+NOTE: since you are doing a resend, a Resent-To header is
-for you to fill in the new recipient list.  If you don't fill in
+provided for you to fill in.  If you don't fill it in, when you
-this header, what happens when you send the message is undefined.
+send the message it will go to the original recipients listed in
-You may also create a Resent-Cc header."
+the To and Cc headers.  You may also create a Resent-Cc header."
 (interactive)
 (vm-follow-summary-cursor)
 (vm-select-folder-buffer)
 (vm-check-for-killed-summary)
 (vm-error-if-folder-empty)
 (interactive "P")
 (vm-select-folder-buffer)
 (vm-check-for-killed-summary)
 (vm-error-if-folder-empty)
 (let ((dir default-directory)
-	(miming (and vm-send-using-mime (equal vm-digest-send-type "mime")))
+	(mp vm-message-pointer)
-	mp mail-buffer b
 	;; prefix arg doesn't have "normal" meaning here, so only call
 	;; vm-select-marked-or-prefixed-messages if we're using marks.
 	(mlist (if (eq last-command 'vm-next-command-uses-marks)
 		   (vm-select-marked-or-prefixed-messages 0)
 		 vm-message-list))
-	start header-end boundary)
+	start)
 (save-restriction
 (widen)
 (vm-mail-internal (format "digest from %s" (buffer-name)))
 (make-local-variable 'vm-forward-list)
 (setq vm-system-state 'forwarding
 	    vm-forward-list mlist
 	    default-directory dir)
-(if miming
+(goto-char (point-min))
-	  (progn
+(re-search-forward (concat "^" (regexp-quote mail-header-separator)
-	    (setq mail-buffer (current-buffer))
+				 "\n"))
-	    (set-buffer (generate-new-buffer "*vm-digest-buffer*"))
+(goto-char (match-end 0))
-	    (setq header-end (point))
+(setq start (point)
-	    (insert "\n")
+	    mp mlist)
-	    (setq start (point-marker)))
+(vm-unsaved-message "Building %s digest..." vm-digest-send-type)
-	(goto-char (point-min))
+(cond ((equal vm-digest-send-type "rfc934")
-	(re-search-forward (concat "^" (regexp-quote mail-header-separator)
-				   "\n"))
-	(goto-char (match-end 0))
-	(setq start (point-marker)
-	      header-end (match-beginning 0)))
-(message "Building %s digest..." vm-digest-send-type)
-(cond ((equal vm-digest-send-type "mime")
-	     (setq boundary (vm-mime-encapsulate-messages
-			     mlist vm-mime-digest-headers
-			     vm-mime-digest-discard-header-regexp
-			     t))
-	     (goto-char header-end)
-	     (insert "MIME-Version: 1.0\n")
-	     (insert (if vm-mime-avoid-folding-content-type
-			 "Content-Type: multipart/digest; boundary=\""
-		       "Content-Type: multipart/digest;\n\tboundary=\"")
-		     boundary "\"\n")
-	     (insert "Content-Transfer-Encoding: "
-		     (vm-determine-proper-content-transfer-encoding
-		      (point)
-		      (point-max))
-		     "\n"))
-	    ((equal vm-digest-send-type "rfc934")
 	     (vm-rfc934-encapsulate-messages
 	      mlist vm-rfc934-digest-headers
 	      vm-rfc934-digest-discard-header-regexp))
 	    ((equal vm-digest-send-type "rfc1153")
 	     (vm-rfc1153-encapsulate-messages
 	      mlist vm-rfc1153-digest-headers
-	      vm-rfc1153-digest-discard-header-regexp)))
+	      vm-rfc1153-digest-discard-header-regexp))
+	    ((equal vm-digest-send-type "rfc1521")
+	     (vm-rfc1521-encapsulate-messages
+	      mlist vm-rfc1521-digest-headers
+	      vm-rfc1521-digest-discard-header-regexp)))
 (goto-char start)
 (setq mp mlist)
-(if miming
-	  (let ((b (current-buffer)))
-	    (set-buffer mail-buffer)
-	    (mail-text)
-	    (vm-mime-attach-object b "multipart/digest"
-				   (list (concat "boundary=\""
-						 boundary "\"")) nil t)
-	    (add-hook 'kill-buffer-hook
-		      (list 'lambda ()
-			    (list 'if (list 'eq mail-buffer '(current-buffer))
-				  (list 'kill-buffer b))))))
 (if prefix
-	  (save-excursion
+	  (progn
-	    (message "Building digest preamble...")
+	    (vm-unsaved-message "Building digest preamble...")
-	    (if miming
-		(progn
-		  (set-buffer mail-buffer)
-		  (mail-text)))
 	    (while mp
 	      (let ((vm-summary-uninteresting-senders nil))
 		(insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
 	      (if vm-digest-center-preamble
 		  (progn
 "Like vm-send-digest but always sends an RFC 1153 digest."
 (interactive "P")
 (let ((vm-digest-send-type "rfc1153"))
 (vm-send-digest preamble)))
-(defun vm-send-mime-digest (&optional preamble)
+(defun vm-send-rfc1521-digest (&optional preamble)
-"Like vm-send-digest but always sends an MIME (multipart/digest) digest."
+"Like vm-send-digest but always sends an RFC 1521 (MIME) digest."
 (interactive "P")
-(let ((vm-digest-send-type "mime"))
+(let ((vm-digest-send-type "rfc1521"))
 (vm-send-digest preamble)))
 (defun vm-continue-composing-message (&optional not-picky)
 "Find and select the most recently used mail composition buffer.
 If the selected buffer is already a Mail mode buffer then it is
 	(progn
 	  ;; avoid having the window configuration code choose a
 	  ;; different composition buffer.
 	  (vm-unbury-buffer b)
 	  (set-buffer b)
-	  (if (and vm-mutable-frames vm-frame-per-composition
+	  (if (and vm-frame-per-composition (vm-multiple-frames-possible-p)
-		   (vm-multiple-frames-possible-p)
 		   ;; only pop up a frame if there's an undisplay
 		   ;; hook in place to make the frame go away.
 		   vm-undisplay-buffer-hook)
 	      (let ((w (vm-get-buffer-window b)))
 		(if (null w)
 		(vm-set-hooks-for-frame-deletion)))
 	  (vm-display b t '(vm-continue-composing-message)
 		      '(vm-continue-composing-message composing-message)))
 (message "No composition buffers found"))))
-(defun vm-mail-to-mailto-url (url)
-(let ((address (car (vm-parse url "^mailto:\\(.+\\)"))))
-(vm-select-folder-buffer)
-(vm-check-for-killed-summary)
-(vm-mail-internal nil address)
-(run-hooks 'vm-mail-hook)
-(run-hooks 'vm-mail-mode-hook)))
 ;; to quiet the v19 byte compiler
 (defvar mail-mode-map)
 (defvar mail-aliases)
 (defvar mail-default-reply-to)
 (defvar mail-signature-file)
 (use-local-map vm-mail-mode-map)
 ;; make mail-mode-map the parent of this vm-mail-mode-map, if we can.
 ;; do it only once.
 (if (not vm-mail-mode-map-parented)
 	(cond ((fboundp 'set-keymap-parents)
-	       (set-keymap-parents vm-mail-mode-map (list mail-mode-map))
+	       (set-keymap-parents vm-mail-mode-map (list mail-mode-map)))
-	       (setq vm-mail-mode-map-parented t))
 	      ((consp mail-mode-map)
 	       (nconc vm-mail-mode-map mail-mode-map)
 	       (setq vm-mail-mode-map-parented t))))
 (setq vm-mail-buffer folder-buffer
-	  mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3
+	  mode-popup-menu (and vm-use-menus
 			       (vm-menu-support-possible-p)
 			       (vm-menu-mode-menu)))
+;; sets up popup menu for FSF Emacs
 (and vm-use-menus (vm-menu-support-possible-p)
 	 (vm-menu-install-mail-mode-menu))
 (if (fboundp 'mail-aliases-setup) ; use mail-abbrevs.el if present
 	(mail-aliases-setup)
 (if (eq mail-aliases t)
 	  (progn
 	    (setq mail-aliases nil)
-	    (if (file-exists-p (or mail-personal-alias-file "~/.mailrc"))
+	    (if (file-exists-p "~/.mailrc")
 		(build-mail-aliases)))))
 (if (stringp vm-mail-header-from)
 	(insert "From: " vm-mail-header-from "\n"))
 (insert "To: " (or to "") "\n")
 (and cc (insert "Cc: " cc "\n"))
 (insert "Subject: " (or subject "") "\n")
 (and newsgroups (insert "Newsgroups: " newsgroups "\n"))
 (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n"))
 (and references (insert "References: " references "\n"))
-(insert "X-Mailer: VM " vm-version " under "
+;; REPLYTO support for FSF Emacs v19.29
-	    (if vm-fsfemacs-19-p "Emacs " "")
+(and (eq mail-default-reply-to t)
-	    emacs-version "\n")
-;; REPLYTO environmental variable support
-;; note that in FSF Emacs v19.29 we would initialize if the
-;; value was t.  nil is the treigger value used now.
-(and (eq mail-default-reply-to nil)
 	 (setq mail-default-reply-to (getenv "REPLYTO")))
 (if mail-default-reply-to
 	(insert "Reply-To: " mail-default-reply-to "\n"))
 (if mail-self-blind
 	(insert "Bcc: " (user-login-name) "\n"))
 				       "~/.signature")))))
 ;; move this buffer to the head of the buffer list so window
 ;; config stuff will select it as the composition buffer.
 (vm-unbury-buffer (current-buffer))
 ;; make a new frame if the user wants it.
-(if (and vm-mutable-frames vm-frame-per-composition
+(if (and vm-frame-per-composition (vm-multiple-frames-possible-p))
-	     (vm-multiple-frames-possible-p))
 	(progn
 	  (vm-goto-new-frame 'composition)
 	  (vm-set-hooks-for-frame-deletion)))
 ;; now do window configuration
 (vm-display (current-buffer) t
 		  vm-send-digest-other-frame
 		  vm-send-rfc934-digest
 		  vm-send-rfc934-digest-other-frame
 		  vm-send-rfc1153-digest
 		  vm-send-rfc1153-digest-other-frame
-		  vm-send-mime-digest
+		  vm-send-rfc1521-digest
-		  vm-send-mime-digest-other-frame
+		  vm-send-rfc1521-digest-other-frame
 		  vm-forward-message
 		  vm-forward-message-other-frame
 		  vm-forward-message-all-headers
 		  vm-forward-message-all-headers-other-frame
 		  vm-resend-message
 	(vm-search-other-frames nil))
 (vm-send-rfc1153-digest prefix))
 (if (vm-multiple-frames-possible-p)
 (vm-set-hooks-for-frame-deletion)))
-(defun vm-send-mime-digest-other-frame (&optional prefix)
+(defun vm-send-rfc1521-digest-other-frame (&optional prefix)
-"Like vm-send-mime-digest, but run in a newly created frame."
+"Like vm-send-rfc1521-digest, but run in a newly created frame."
 (interactive "P")
 (if (vm-multiple-frames-possible-p)
 (vm-goto-new-frame 'composition))
 (let ((vm-frame-per-composition nil)
 	(vm-search-other-frames nil))
-(vm-send-mime-digest prefix))
+(vm-send-rfc1153-digest prefix))
 (if (vm-multiple-frames-possible-p)
 (vm-set-hooks-for-frame-deletion)))

Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-reply.el @ 70:131b0175ea99 r20-0b30