comparison lisp/gnus/message.el @ 34797:b473bc6d9a55

* 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.

34796:560b081d8800

  :group 'message-forwarding
  :type 'boolean)

(defcustom message-forward-show-mml t
  "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
  :group 'message-forwarding
  :type 'boolean)

(defcustom message-forward-before-signature t
  "*If non-nil, put forwarded message before signature, else after."

  "A regexp to match the alternative email addresses.
The first matched address (not primary one) is used in the From field."
  :group 'message-headers
  :type '(choice (const :tag "Always use primary" nil)
		 regexp))

;;; Internal variables.

(defvar message-sending-message "Sending...")
(defvar message-buffer-list nil)

	    (if (or
		 (and message-reply-headers
		      (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))
			    (message-strip-subject-re psubject))))
		 (and psupersedes

  ;; Push the current buffer onto the list.
  (when message-max-buffers
    (setq message-buffer-list
	  (nconc message-buffer-list (list (current-buffer))))))

(eval-when-compile (defvar mc-modes-alist))
(defun message-setup (headers &optional replybuffer actions)
  (when (and (boundp 'mc-modes-alist)
	     (not (assq 'message-mode mc-modes-alist)))
    (push '(message-mode (encrypt . mc-encrypt-message)
			 (sign . mc-sign-message))
	  mc-modes-alist))

			       yank-action send-actions)
  "Start editing a mail message to be sent.
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))
    (message-setup
     (nconc
      `((To . ,(or to "")) (Subject . ,(or subject "")))
      (when other-headers other-headers)))))

      (setq message-id (match-string 0 gnus-warning)))

    (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)))

    (setq message-reply-headers
	  (vector 0 subject from date message-id references 0 0 ""))

    (message-setup

		(mm-disable-multibyte) ;; Must copy buffer in unibyte mode
		(setq tmp (current-buffer))
		(set-buffer cur)
		(mm-with-unibyte-current-buffer
		  (set-buffer tmp)
		  (insert-buffer-substring cur))
		(set-buffer tmp)
		(mm-enable-multibyte)
		(mime-to-mml)
		(goto-char (point-min))
		(when (looking-at "From ")
		  (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))))
      (setq e (point))
      (if message-forward-as-mime
	  (if digest
	      (insert "<#/multipart>\n")
	    (if message-forward-show-mml

  (message "Resending message to %s..." address)
  (save-excursion
    (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)))
      ;; Insert our usual headers.
      (message-generate-headers '(From Date To))
      (message-narrow-to-headers)
      ;; Rename them all to "Resent-*".
      (while (re-search-forward "^[A-Za-z]" nil t)

;;;###autoload
(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)))
  (let ((message-this-is-mail t))
    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))

;;;###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)))
  (let ((message-this-is-mail t))
    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))

;;;###autoload
(defun message-news-other-window (&optional newsgroups subject)
  "Start editing a news article to be sent."
  (interactive)

34797:b473bc6d9a55

  :group 'message-forwarding
  :type 'boolean)

(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)

(defcustom message-forward-before-signature t
  "*If non-nil, put forwarded message before signature, else after."

  "A regexp to match the alternative email addresses.
The first matched address (not primary one) is used in the From field."
  :group 'message-headers
  :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...")
(defvar message-buffer-list nil)

	    (if (or
		 (and message-reply-headers
		      (mail-header-references message-reply-headers)
		      (mail-header-subject message-reply-headers)
		      psubject
		      (not (string=
			    (message-strip-subject-re
			     (mail-header-subject message-reply-headers))
			    (message-strip-subject-re psubject))))
		 (and psupersedes

  ;; Push the current buffer onto the list.
  (when message-max-buffers
    (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-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)
			 (sign . mc-sign-message))
	  mc-modes-alist))

			       yank-action send-actions)
  "Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs."
  (interactive)
  (let ((message-this-is-mail t))
    (unless (message-mail-user-agent)
      (message-pop-to-buffer (message-buffer-name "mail" to)))
    (message-setup
     (nconc
      `((To . ,(or to "")) (Subject . ,(or subject "")))
      (when other-headers other-headers)))))

      (setq message-id (match-string 0 gnus-warning)))

    (unless follow-to
      (setq follow-to (message-get-reply-headers wide to-address))))

    (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 ""))

    (message-setup

		(mm-disable-multibyte) ;; Must copy buffer in unibyte mode
		(setq tmp (current-buffer))
		(set-buffer cur)
		(mm-with-unibyte-current-buffer
		  (set-buffer tmp)
		  (insert-buffer-substring cur)
		  (set-buffer cur))
		(set-buffer tmp)
		(mm-enable-multibyte)
		(mime-to-mml)
		(goto-char (point-min))
		(when (looking-at "From ")
		  (replace-match "X-From-Line: "))
		(set-buffer target)
		(insert-buffer-substring tmp)
		(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
	      (insert "<#/multipart>\n")
	    (if message-forward-show-mml

  (message "Resending message to %s..." address)
  (save-excursion
    (let ((cur (current-buffer))
	  beg)
      ;; We first set up a normal mail buffer.
      (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)
      ;; Rename them all to "Resent-*".
      (while (re-search-forward "^[A-Za-z]" nil t)

;;;###autoload
(defun message-mail-other-window (&optional to subject)
  "Like `message-mail' command, but display mail buffer in another window."
  (interactive)
  (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 "")))
		   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)
  (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 "")))
		   nil nil 'switch-to-buffer-other-frame)))

;;;###autoload
(defun message-news-other-window (&optional newsgroups subject)
  "Start editing a news article to be sent."
  (interactive)