emacs: lisp/gnus/message.el comparison

comparison lisp/gnus/message.el @ 41511:19496cafe865

2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu> * mail/rmail.el (rmail-enable-mime-composing): New. A lightweight version of rmail-enable-mime. (rmail-forward): Use it. * message.el (message-forward-rmail-make-body): save-window-excursion. (message-encode-message-body): no error. (message-setup-1): compose-mail send-actions are different from message-send-actions. * message.el (message-forward-subject-author-subject): Don't use message-news-p, which widens the buffer. (message-forward-make-body): New function. (message-forward): Use it. (message-insinuate-rmail): New. (message-forward-rmail-make-body): New.

author	ShengHuo ZHU <zsh@cs.rochester.edu>
date	Sun, 25 Nov 2001 20:45:37 +0000
parents	933ab100fb4a
children	a96c3ddfa03e

comparison

equal deleted inserted replaced

-:69925dd4cdc7
+:19496cafe865
 (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))
-(when actions
+(dolist (action actions)
-(setq message-send-actions actions))
+(condition-case nil
+	(add-to-list 'message-send-actions
+		     `(apply ',(car action) ',(cdr action)))))
 (setq message-reply-buffer replybuffer)
 (goto-char (point-min))
 ;; Insert all the headers.
 (mail-header-format
 (let ((h headers)
 The form is: [Source] Subject, where if the original message was mail,
 Source is the sender, and if the original message was news, Source is
 the list of newsgroups is was posted to."
 (concat "["
 	   (let ((prefix
-		  (or (message-fetch-field
+		  (or (message-fetch-field "newsgroups")
-		       (if (message-news-p) "newsgroups" "from"))
+		      (message-fetch-field "from")
 		      "(nowhere)")))
 	     (if message-forward-decoded-p
 		 prefix
 	       (mail-decode-encoded-word-string prefix)))
 	  "] " subject))
 	subject))))
 (eval-when-compile
 (defvar gnus-article-decoded-p))
 ;;;###autoload
 (defun message-forward (&optional news digest)
 "Forward the current message via mail.
 Optional NEWS will use news to forward instead of mail.
 Optional DIGEST will use digest to forward."
 (interactive "P")
 (let* ((cur (current-buffer))
 	 (message-forward-decoded-p
 	  (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
-	      gnus-article-decoded-p  ;; In an article buffer.
+	      gnus-article-decoded-p ;; In an article buffer.
 	    message-forward-decoded-p))
-	 (subject (message-make-forward-subject))
+	 (subject (message-make-forward-subject)))
-	 art-beg)
 (if news
 	(message-news nil subject)
 (message-mail nil subject))
-;; Put point where we want it before inserting the forwarded
+(message-forward-make-body cur digest)))
-;; message.
-(if message-forward-before-signature
+;;;###autoload
-(message-goto-body)
+(defun message-forward-make-body (forward-buffer &optional digest)
-(goto-char (point-max)))
+;; Put point where we want it before inserting the forwarded
-(if message-forward-as-mime
+;; message.
-	(if digest
+(if message-forward-before-signature
-	    (insert "\n<#multipart type=digest>\n")
+(message-goto-body)
-	  (if message-forward-show-mml
+(goto-char (point-max)))
-	      (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+(if message-forward-as-mime
-	    (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
-(insert "\n-------------------- Start of forwarded message --------------------\n"))
-(let ((b (point)) e)
 (if digest
-	  (if message-forward-as-mime
+	  (insert "\n<#multipart type=digest>\n")
-	      (insert-buffer-substring cur)
+	(if message-forward-show-mml
-	    (mml-insert-buffer cur))
+	    (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
-	(if (and message-forward-show-mml
+	  (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
-		 (not message-forward-decoded-p))
+(insert "\n-------------------- Start of forwarded message --------------------\n"))
-	    (insert
+(let ((b (point)) e)
-	     (with-temp-buffer
+(if digest
-	       (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
+	(if message-forward-as-mime
+	    (insert-buffer-substring forward-buffer)
+	  (mml-insert-buffer forward-buffer))
+(if (and message-forward-show-mml
+	       (not message-forward-decoded-p))
+	  (insert
+	   (with-temp-buffer
+	     (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
 	       (insert
-		(with-current-buffer cur
+		(with-current-buffer forward-buffer
 		  (mm-string-as-unibyte (buffer-string))))
 	       (mm-enable-multibyte-mule4)
 	       (mime-to-mml)
 	       (goto-char (point-min))
 	       (when (looking-at "From ")
 		 (replace-match "X-From-Line: "))
 	       (buffer-string)))
-	  (save-restriction
+	(save-restriction
-	    (narrow-to-region (point) (point))
+	  (narrow-to-region (point) (point))
-	    (mml-insert-buffer cur)
+	  (mml-insert-buffer forward-buffer)
-	    (goto-char (point-min))
+	  (goto-char (point-min))
-	    (when (looking-at "From ")
+	  (when (looking-at "From ")
-	      (replace-match "X-From-Line: "))
+	    (replace-match "X-From-Line: "))
-	    (goto-char (point-max)))))
+	  (goto-char (point-max)))))
 (setq e (point))
 (if message-forward-as-mime
-	  (if digest
+	(if digest
-	      (insert "<#/multipart>\n")
+	    (insert "<#/multipart>\n")
-	    (if message-forward-show-mml
+	  (if message-forward-show-mml
-		(insert "<#/mml>\n")
+	      (insert "<#/mml>\n")
-	      (insert "<#/part>\n")))
+	    (insert "<#/part>\n")))
-	(insert "\n-------------------- End of forwarded message --------------------\n"))
+(insert "\n-------------------- End of forwarded message --------------------\n"))
 (if (and digest message-forward-as-mime)
-	  (save-restriction
+	(save-restriction
-	    (narrow-to-region b e)
+	  (narrow-to-region b e)
-	    (goto-char b)
+	  (goto-char b)
-	    (narrow-to-region (point)
+	  (narrow-to-region (point)
-			      (or (search-forward "\n\n" nil t) (point)))
+			    (or (search-forward "\n\n" nil t) (point)))
-	    (delete-region (point-min) (point-max)))
+	  (delete-region (point-min) (point-max)))
-	(when (and (not current-prefix-arg)
+(when (and (not current-prefix-arg)
-		   message-forward-ignored-headers)
+		 message-forward-ignored-headers)
-	  (save-restriction
+	(save-restriction
-	    (narrow-to-region b e)
+	  (narrow-to-region b e)
-	    (goto-char b)
+	  (goto-char b)
-	    (narrow-to-region (point)
+	  (narrow-to-region (point)
-			      (or (search-forward "\n\n" nil t) (point)))
+			    (or (search-forward "\n\n" nil t) (point)))
-	    (message-remove-header message-forward-ignored-headers t)))))
+	  (message-remove-header message-forward-ignored-headers t)))))
-(message-position-point)))
+(message-position-point))
+;;;###autoload
+(defun message-forward-rmail-make-body (forward-buffer)
+(save-window-excursion
+(set-buffer forward-buffer)
+(let (rmail-enable-mime)
+(rmail-toggle-header 0)))
+(message-forward-make-body forward-buffer))
+;;;###autoload
+(defun message-insinuate-rmail ()
+"Let RMAIL uses message to forward."
+(interactive)
+(setq rmail-enable-mime-composing t)
+(setq rmail-insert-mime-forwarded-message-function
+	'message-forward-rmail-make-body))
 ;;;###autoload
 (defun message-resend (address)
 "Resend the current article to ADDRESS."
 (interactive
 ;; when confronted with a message with a MIME-Version header and
 ;; without a Content-Type header.  For instance, Solaris'
 ;; /usr/bin/mail.
 (unless content-type-p
 	(goto-char (point-min))
-	(re-search-forward "^MIME-Version:")
+	;; For unknown reason, MIME-Version doesn't exist.
-	(forward-line 1)
+	(when (re-search-forward "^MIME-Version:" nil t)
-	(insert "Content-Type: text/plain; charset=us-ascii\n")))))
+	  (forward-line 1)
+	  (insert "Content-Type: text/plain; charset=us-ascii\n"))))))
 (defun message-read-from-minibuffer (prompt)
 "Read from the minibuffer while providing abbrev expansion."
 (if (fboundp 'mail-abbrevs-setup)
 (let ((mail-abbrev-mode-regexp "")

Mercurial > emacs

comparison lisp/gnus/message.el @ 41511:19496cafe865