Mercurial > emacs

changeset 34797:b473bc6d9a55

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* mml.el (gnus-add-minor-mode): Autoload. * message.el (message-forward): Save-restriction. * message.el (message-mail-user-agent): Add :version. * message.el (message-mail-user-agent): New variable. (message-setup): Renamed to message-setup-1. Support mail-user-agent. (message-mail-user-agent): New function. (message-mail): Use it. (message-reply): Use it. (message-resend): Use it. (message-mail-other-window): Use it. (message-mail-other-frame): Use it. * gnus-msg.el (gnus-bug): Support mail-user-agent.
author ShengHuo ZHU <zsh@cs.rochester.edu>
date Thu, 21 Dec 2000 19:58:34 +0000
parents 560b081d8800
children 9794feac3a9d
files lisp/gnus/ChangeLog lisp/gnus/gnus-msg.el lisp/gnus/message.el lisp/gnus/mml.el
diffstat 4 files changed, 128 insertions(+), 42 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Thu Dec 21 16:57:00 2000 +0000
+++ b/lisp/gnus/ChangeLog	Thu Dec 21 19:58:34 2000 +0000
@@ -1,3 +1,23 @@
+2000-12-21 14:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+	* mml.el (gnus-add-minor-mode): Autoload.
+
+	* message.el (message-forward): Save-restriction.
+
+	* message.el (message-mail-user-agent): Add :version.
+
+	* message.el (message-mail-user-agent): New variable.
+	(message-setup): Renamed to message-setup-1. Support
+	mail-user-agent.
+	(message-mail-user-agent): New function.
+	(message-mail): Use it.
+	(message-reply): Use it.
+	(message-resend): Use it.
+	(message-mail-other-window): Use it.
+	(message-mail-other-frame): Use it.
+
+	* gnus-msg.el (gnus-bug): Support mail-user-agent.
+
 2000-12-21  Miles Bader  <miles@gnu.org>
 
 	* message.el (message-mode): Set `comment-start' to the  yank prefix.
--- a/lisp/gnus/gnus-msg.el	Thu Dec 21 16:57:00 2000 +0000
+++ b/lisp/gnus/gnus-msg.el	Thu Dec 21 19:58:34 2000 +0000
@@ -893,15 +893,17 @@
   (interactive)
   (unless (gnus-alive-p)
     (error "Gnus has been shut down"))
-  (gnus-setup-message 'bug
-    (delete-other-windows)
-    (when gnus-bug-create-help-buffer
-      (switch-to-buffer "*Gnus Help Bug*")
-      (erase-buffer)
-      (insert gnus-bug-message)
-      (goto-char (point-min)))
-    (message-pop-to-buffer "*Gnus Bug*")
-    (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+  (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
+    (unless (message-mail-user-agent)
+      (delete-other-windows)
+      (when gnus-bug-create-help-buffer
+	(switch-to-buffer "*Gnus Help Bug*")
+	(erase-buffer)
+	(insert gnus-bug-message)
+	(goto-char (point-min)))
+      (message-pop-to-buffer "*Gnus Bug*"))
+    (let ((message-this-is-mail t))
+      (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
     (when gnus-bug-create-help-buffer
       (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))
--- a/lisp/gnus/message.el	Thu Dec 21 16:57:00 2000 +0000
+++ b/lisp/gnus/message.el	Thu Dec 21 19:58:34 2000 +0000
@@ -303,6 +303,7 @@
 
 (defcustom message-forward-show-mml t
   "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
+  :version "21.1"
   :group 'message-forwarding
   :type 'boolean)
 
@@ -917,6 +918,26 @@
   :type '(choice (const :tag "Always use primary" nil)
 		 regexp))
 
+(defcustom message-mail-user-agent nil
+  "Like `mail-user-agent'.
+Except if it is `nil', use Gnus native MUA; if it is t, use
+`mail-user-agent'."
+  :type '(radio (const :tag "Gnus native"
+		       :format "%t\n"
+		       nil)
+		(const :tag "`mail-user-agent'"
+		       :format "%t\n"
+		       t)
+		(function-item :tag "Default Emacs mail"
+			       :format "%t\n"
+			       sendmail-user-agent)
+		(function-item :tag "Emacs interface to MH"
+			       :format "%t\n"
+			       mh-e-user-agent)
+		(function :tag "Other"))
+  :version "21.1"
+  :group 'message)
+
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")
@@ -2986,7 +3007,6 @@
 		      (mail-header-references message-reply-headers)
 		      (mail-header-subject message-reply-headers)
 		      psubject
-		      (mail-header-subject message-reply-headers)
 		      (not (string=
 			    (message-strip-subject-re
 			     (mail-header-subject message-reply-headers))
@@ -3560,8 +3580,42 @@
     (setq message-buffer-list
 	  (nconc message-buffer-list (list (current-buffer))))))
 
+(defun message-mail-user-agent ()
+  (let ((mua (cond
+	      ((not message-mail-user-agent) nil)
+	      ((eq message-mail-user-agent t) mail-user-agent)
+	      (t message-mail-user-agent))))
+    (if (memq mua '(message-user-agent gnus-user-agent))
+	nil
+      mua)))
+
+(defun message-setup (headers &optional replybuffer actions switch-function)
+  (let ((mua (message-mail-user-agent))
+	subject to field yank-action)
+    (if (not (and message-this-is-mail mua))
+	(message-setup-1 headers replybuffer actions)
+      (if replybuffer
+	  (setq yank-action (list 'insert-buffer replybuffer)))
+      (setq headers (copy-sequence headers))
+      (setq field (assq 'Subject headers))
+      (when field
+	(setq subject (cdr field))
+	(setq headers (delq field headers)))
+      (setq field (assq 'To headers))
+      (when field
+	(setq to (cdr field))
+	(setq headers (delq field headers)))
+      (let ((mail-user-agent mua))
+	(compose-mail to subject 
+		      (mapcar (lambda (item)
+				(cons
+				 (format "%s" (car item))
+				 (cdr item)))
+			      headers)
+		      nil switch-function yank-action actions))))) 
+ 
 (eval-when-compile (defvar mc-modes-alist))
-(defun message-setup (headers &optional replybuffer actions)
+(defun message-setup-1 (headers &optional replybuffer actions)
   (when (and (boundp 'mc-modes-alist)
 	     (not (assq 'message-mode mc-modes-alist)))
     (push '(message-mode (encrypt . mc-encrypt-message)
@@ -3675,7 +3729,8 @@
 OTHER-HEADERS is an alist of header/value pairs."
   (interactive)
   (let ((message-this-is-mail t))
-    (message-pop-to-buffer (message-buffer-name "mail" to))
+    (unless (message-mail-user-agent)
+      (message-pop-to-buffer (message-buffer-name "mail" to)))
     (message-setup
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
@@ -3791,10 +3846,11 @@
     (unless follow-to
       (setq follow-to (message-get-reply-headers wide to-address))))
 
-    (message-pop-to-buffer
-     (message-buffer-name
-      (if wide "wide reply" "reply") from
-      (if wide to-address nil)))
+    (unless (message-mail-user-agent)
+      (message-pop-to-buffer
+       (message-buffer-name
+	(if wide "wide reply" "reply") from
+	(if wide to-address nil))))
 
     (setq message-reply-headers
 	  (vector 0 subject from date message-id references 0 0 ""))
@@ -4146,7 +4202,8 @@
 		(set-buffer cur)
 		(mm-with-unibyte-current-buffer
 		  (set-buffer tmp)
-		  (insert-buffer-substring cur))
+		  (insert-buffer-substring cur)
+		  (set-buffer cur))
 		(set-buffer tmp)
 		(mm-enable-multibyte)
 		(mime-to-mml)
@@ -4155,13 +4212,14 @@
 		  (replace-match "X-From-Line: "))
 		(set-buffer target)
 		(insert-buffer-substring tmp)
-		(set-buffer tmp))
-	      (goto-char (point-max)))
-	  (mml-insert-buffer cur)
-	  (goto-char (point-min))
-	  (when (looking-at "From ")
-	    (replace-match "X-From-Line: "))
-	  (goto-char (point-max))))
+		(set-buffer tmp)))
+	  (save-restriction
+	    (narrow-to-region (point) (point))
+	    (mml-insert-buffer cur)
+	    (goto-char (point-min))
+	    (when (looking-at "From ")
+	      (replace-match "X-From-Line: "))
+	    (goto-char (point-max)))))
       (setq e (point))
       (if message-forward-as-mime
 	  (if digest
@@ -4197,9 +4255,11 @@
     (let ((cur (current-buffer))
 	  beg)
       ;; We first set up a normal mail buffer.
-      (set-buffer (get-buffer-create " *message resend*"))
-      (erase-buffer)
-      (message-setup `((To . ,address)))
+      (unless (message-mail-user-agent)
+	(set-buffer (get-buffer-create " *message resend*"))
+	(erase-buffer))
+      (let ((message-this-is-mail t))
+	(message-setup `((To . ,address))))
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To))
       (message-narrow-to-headers)
@@ -4281,27 +4341,31 @@
 (defun message-mail-other-window (&optional to subject)
   "Like `message-mail' command, but display mail buffer in another window."
   (interactive)
-  (let ((pop-up-windows t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "mail" to)))
+  (unless (message-mail-user-agent)
+    (let ((pop-up-windows t)
+	  (special-display-buffer-names nil)
+	  (special-display-regexps nil)
+	  (same-window-buffer-names nil)
+	  (same-window-regexps nil))
+      (message-pop-to-buffer (message-buffer-name "mail" to))))
   (let ((message-this-is-mail t))
-    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
+		   nil nil 'switch-to-buffer-other-window)))
 
 ;;;###autoload
 (defun message-mail-other-frame (&optional to subject)
   "Like `message-mail' command, but display mail buffer in another frame."
   (interactive)
-  (let ((pop-up-frames t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "mail" to)))
+  (unless (message-mail-user-agent)
+    (let ((pop-up-frames t)
+	  (special-display-buffer-names nil)
+	  (special-display-regexps nil)
+	  (same-window-buffer-names nil)
+	  (same-window-regexps nil))
+      (message-pop-to-buffer (message-buffer-name "mail" to))))
   (let ((message-this-is-mail t))
-    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
+		   nil nil 'switch-to-buffer-other-frame)))
 
 ;;;###autoload
 (defun message-news-other-window (&optional newsgroups subject)
--- a/lisp/gnus/mml.el	Thu Dec 21 16:57:00 2000 +0000
+++ b/lisp/gnus/mml.el	Thu Dec 21 19:58:34 2000 +0000
@@ -27,12 +27,12 @@
 (require 'mm-bodies)
 (require 'mm-encode)
 (require 'mm-decode)
-(require 'gnus-ems)
 (eval-when-compile (require 'cl))
 
 (eval-and-compile
   (autoload 'message-make-message-id "message")
   (autoload 'gnus-setup-posting-charset "gnus-msg")
+  (autoload 'gnus-add-minor-mode "gnus-ems")
   (autoload 'message-fetch-field "message")
   (autoload 'message-posting-charset "message"))