X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=c4bf6bfc6389b738e9e0ce9737cc2a6f28d46e3f;hb=9b6c272d50c6896583a69d40d9e9b15cabaf4247;hp=4bd9ca36ed43abafa4710c8d4c45835db2a32d73;hpb=7cfae5600f322b9f606db8d725c1a7ace981f2e7;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 4bd9ca3..c4bf6bf 100644
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -1,11 +1,12 @@
 ;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;	Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
 ;;	Katsumi Yamaoka  <yamaoka@jpl.org>
+;;	Kiyokazu SUTO    <suto@merry.xmath.ous.ac.jp>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -111,6 +112,17 @@ the second with the current group name.")
     (name . user-full-name))
   "*Mapping from style parameters to variables.")
 
+(defcustom gnus-group-posting-charset-alist
+  '(("^no\\." iso-8859-1)
+    (".*" iso-8859-1)
+    (message-this-is-news iso-8859-1)
+    (message-this-is-mail nil)
+    )
+  "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
+  :type '(repeat (list (regexp :tag "Group")
+		       (symbol :tag "Charset")))
+  :group 'gnus-charset)
+
 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
@@ -218,11 +230,26 @@ Thank you for your help in stamping out bugs.
 	 (set (make-local-variable 'gnus-message-group-art)
 	      (cons ,group ,article))
 	 (set (make-local-variable 'gnus-newsgroup-name) ,group)
+	 (set (make-local-variable 'message-posting-charset)
+	      (gnus-setup-posting-charset ,group))
 	 (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
        (set-buffer-modified-p nil))))
 
+(defun gnus-setup-posting-charset (group)
+  (let ((alist gnus-group-posting-charset-alist)
+	elem)
+    (catch 'found
+      (while (setq elem (pop alist))
+	(when (or (and (stringp (car elem))
+		       (string-match (car elem) group))
+		  (and (gnus-functionp (car elem))
+		       (funcall (car elem) group))
+		  (and (symbolp (car elem))
+		       (symbol-value (car elem))))
+	  (throw 'found (cadr elem)))))))
+
 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
@@ -325,13 +352,26 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (gnus-summary-followup (gnus-summary-work-articles arg) t))
 
 (defun gnus-inews-yank-articles (articles)
-  (let (beg article)
+  (let* ((more-than-one (cdr articles))
+	 (frame (when (and message-use-multi-frames more-than-one)
+		  (window-frame (get-buffer-window (current-buffer)))))
+	 refs beg article)
     (message-goto-body)
     (while (setq article (pop articles))
       (save-window-excursion
 	(set-buffer gnus-summary-buffer)
 	(gnus-summary-select-article nil nil nil article)
 	(gnus-summary-remove-process-mark article))
+      (when frame
+	(select-frame frame))
+
+      ;; Gathering references.
+      (when more-than-one
+	(setq refs (message-list-references
+		    refs
+		    (mail-header-references gnus-current-headers)
+		    (mail-header-message-id gnus-current-headers))))
+
       (gnus-copy-article-buffer)
       (let ((message-reply-buffer gnus-article-copy)
 	    (message-reply-headers gnus-current-headers))
@@ -340,6 +380,25 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
       (when articles
 	(insert "\n")))
     (push-mark)
+
+    ;; Replace with the gathered references.
+    (when refs
+      (push-mark beg)
+      (save-restriction
+	(message-narrow-to-headers)
+	(let ((case-fold-search t))
+	  (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+	      (replace-match "")
+	    (goto-char (point-max))))
+	(mail-header-format
+	 (list (or (assq 'References message-header-format-alist)
+		   '(References . message-shorten-references)))
+	 (list (cons 'References
+		     (mapconcat 'identity (nreverse refs) " "))))
+	(backward-delete-char 1))
+      (setq beg (mark t))
+      (pop-mark))
+
     (goto-char beg)))
 
 (defun gnus-summary-cancel-article (&optional n symp)
@@ -697,7 +756,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
   "Digest and forwards all articles in this series to a newsgroup."
   (interactive "P")
   (gnus-summary-mail-digest n t))
- 
+
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive "sResend message(s) to: \nP")
@@ -1190,21 +1249,20 @@ this is a reply."
 		  (set (make-local-variable variable) value-value)
 		;; This is either a body or a header to be inserted in the
 		;; message.
-		(when value-value
-		  (let ((attr (car attribute)))
-		    (make-local-variable 'message-setup-hook)
-		    (if (eq 'body attr)
-			(add-hook 'message-setup-hook
-				  `(lambda ()
-				     (save-excursion
-				       (message-goto-body)
-				       (insert ,value-value))))
+		(let ((attr (car attribute)))
+		  (make-local-variable 'message-setup-hook)
+		  (if (eq 'body attr)
 		      (add-hook 'message-setup-hook
-				'gnus-message-insert-stylings)
-		      (push (cons (if (stringp attr) attr
-				    (symbol-name attr))
-				  value-value)
-			    gnus-message-style-insertions))))))))))))
+				`(lambda ()
+				   (save-excursion
+				     (message-goto-body)
+				     (insert ,value-value))))
+		    (add-hook 'message-setup-hook
+			      'gnus-message-insert-stylings)
+		    (push (cons (if (stringp attr) attr
+				  (symbol-name attr))
+				value-value)
+			  gnus-message-style-insertions)))))))))))
 
 (defun gnus-message-insert-stylings ()
   (let (val)