Merge chao-gnus-6_12_5.
[elisp/gnus.git-] / lisp / gnus-msg.el
index b0e73aa..359409e 100644 (file)
@@ -1,9 +1,11 @@
-;;; gnus-msg.el --- mail and post interface for Gnus
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;     Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
@@ -91,7 +93,7 @@ Thank you.
 The first %s will be replaced by the Newsgroups header;
 the second with the current group name.")
 
-(defvar gnus-message-setup-hook nil
+(defvar gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
   "Hook run after setting up a message buffer.")
 
 (defvar gnus-bug-create-help-buffer t
@@ -119,7 +121,13 @@ the second with the current group name.")
 (defvar gnus-message-group-art nil)
 
 (defconst gnus-bug-message
-  "Sending a bug report to the Gnus Towers.
+  (format "Sending a bug report to the Gnus Towers.
+========================================
+
+This gnus is the %s%s.
+If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus
+Developers. (the addresses below are mailing list addresses)
+
 ========================================
 
 The buffer below is a mail buffer.  When you press `C-c C-c', it will
@@ -136,7 +144,11 @@ and include the backtrace in your bug report.
 Please describe the bug in annoying, painstaking detail.
 
 Thank you for your help in stamping out bugs.
-")
+"
+         gnus-product-name
+         (if (string= gnus-product-name "Semi-gnus")
+             ""
+           ", a modified version of Semi-gnus")))
 
 (eval-and-compile
   (autoload 'gnus-uu-post-news "gnus-uu" nil t)
@@ -167,8 +179,8 @@ Thank you for your help in stamping out bugs.
   "\M-c" gnus-summary-mail-crosspost-complaint
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
-  "Om" gnus-uu-digest-mail-forward
-  "Op" gnus-uu-digest-post-forward)
+  "Om" gnus-summary-mail-digest
+  "Op" gnus-summary-post-digest)
 
 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
   "b" gnus-summary-resend-bounced-mail
@@ -212,7 +224,7 @@ Thank you for your help in stamping out bugs.
   (setq message-post-method
        `(lambda (arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))
-  (setq message-newsreader (setq message-mailer (gnus-extended-version)))
+  (setq message-user-agent (gnus-extended-version))
   (message-add-action
    `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
   (message-add-action
@@ -319,8 +331,10 @@ post using the current select method."
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)
-       (when (gnus-eval-in-buffer-window gnus-original-article-buffer
-               (message-cancel-news))
+       (when (gnus-eval-in-buffer-window gnus-article-buffer
+               (save-excursion
+                 (set-buffer gnus-original-article-buffer)
+                 (message-cancel-news)))
          (gnus-summary-mark-as-read article gnus-canceled-mark)
          (gnus-cache-remove-article 1))
        (gnus-article-hide-headers-if-wanted))
@@ -524,67 +538,14 @@ If SILENT, don't prompt the user."
 \f
 
 ;; Dummy to avoid byte-compile warning.
-(defvar nnspool-rejected-article-hook)
-(defvar xemacs-codename)
+;;(defvar nnspool-rejected-article-hook)
+;;(defvar xemacs-codename)
 
-;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
-;;; as well include the Emacs version as well.
-;;; The following function works with later GNU Emacs, and XEmacs.
+;;; Since the User-Agent is ``vanity'' headers.
 (defun gnus-extended-version ()
-  "Stringified Gnus version and Emacs version."
+  "Stringified gnus version."
   (interactive)
-  (concat
-   gnus-version
-   "/"
-   (cond
-    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
-     (concat "Emacs " (substring emacs-version
-                                (match-beginning 1)
-                                (match-end 1))))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
-                  emacs-version)
-     (concat (substring emacs-version
-                       (match-beginning 1)
-                       (match-end 1))
-            (format " %d.%d" emacs-major-version emacs-minor-version)
-            (if (match-beginning 3)
-                (substring emacs-version
-                           (match-beginning 3)
-                           (match-end 3))
-              "")
-            (if (boundp 'xemacs-codename)
-                (concat " - \"" xemacs-codename "\""))))
-    (t emacs-version))))
-
-;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
-(defun gnus-inews-insert-mime-headers ()
-  "Insert MIME headers.
-Assumes ISO-Latin-1 is used iff 8-bit characters are present."
-  (goto-char (point-min))
-  (let ((mail-header-separator
-        (progn
-          (goto-char (point-min))
-          (if (and (search-forward (concat "\n" mail-header-separator "\n")
-                                   nil t)
-                   (not (search-backward "\n\n" nil t)))
-              mail-header-separator
-            ""))))
-    (or (mail-position-on-field "Mime-Version")
-       (insert "1.0")
-       (cond ((save-restriction
-                (widen)
-                (goto-char (point-min))
-                (re-search-forward "[^\000-\177]" nil t))
-              (or (mail-position-on-field "Content-Type")
-                  (insert "text/plain; charset=ISO-8859-1"))
-              (or (mail-position-on-field "Content-Transfer-Encoding")
-                  (insert "8bit")))
-             (t (or (mail-position-on-field "Content-Type")
-                    (insert "text/plain; charset=US-ASCII"))
-                (or (mail-position-on-field "Content-Transfer-Encoding")
-                    (insert "7bit")))))))
-
-(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers)
+  (concat gnus-product-name "/" gnus-version-number))
 
 \f
 ;;;
@@ -639,11 +600,48 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
   (interactive "P")
   (gnus-setup-message 'forward
     (gnus-summary-select-article)
-    (set-buffer gnus-original-article-buffer)
+    (let ((charset default-mime-charset))
+      (set-buffer gnus-original-article-buffer)
+      (make-local-variable 'default-mime-charset)
+      (setq default-mime-charset charset)
+      )
     (let ((message-included-forward-headers
           (if full-headers "" message-included-forward-headers)))
       (message-forward post))))
 
+(defun gnus-summary-post-forward (&optional full-headers)
+  "Forward the current article to a newsgroup.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+  (interactive "P")
+  (gnus-summary-mail-forward full-headers t))
+
+;;; XXX: generate Subject and ``Topics''?
+(defun gnus-summary-mail-digest (&optional n post)
+  "Digests and forwards all articles in this series."
+  (interactive "P")
+  (let ((subject "Digested Articles")
+       (articles (gnus-summary-work-articles n))
+       article)
+    (gnus-setup-message 'forward
+      (gnus-summary-select-article)
+      (if post (message-news nil subject) (message-mail nil subject))
+      (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))
+       (insert (mime-make-tag "message" "rfc822") "\n")
+       (insert-buffer-substring gnus-original-article-buffer))
+      (push-mark)
+      (message-goto-body)
+      (mime-edit-enclose-digest-region (point)(mark t)))))
+
+(defun gnus-summary-post-digest (&optional n)
+  "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")
@@ -655,12 +653,6 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
        (set-buffer gnus-original-article-buffer)
        (message-resend address)))))
 
-(defun gnus-summary-post-forward (&optional full-headers)
-  "Forward the current article to a newsgroup.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
-  (interactive "P")
-  (gnus-summary-mail-forward full-headers t))
-
 (defvar gnus-nastygram-message
   "The following article was inappropriately posted to %s.\n\n"
   "Format string to insert in nastygrams.
@@ -819,7 +811,8 @@ If YANK is non-nil, include the original article."
       (insert gnus-bug-message)
       (goto-char (point-min)))
     (message-pop-to-buffer "*Gnus Bug*")
-    (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+    (message-setup
+     `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . "")))
     (when gnus-bug-create-help-buffer
       (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))
@@ -933,7 +926,7 @@ this is a reply."
       (save-restriction
        (message-narrow-to-headers)
        (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
-             (cur (current-buffer))
+             (coding-system-for-write 'raw-text)
              groups group method)
          (when gcc
            (message-remove-header "gcc")
@@ -961,7 +954,8 @@ this is a reply."
                (gnus-request-create-group group method))
              (save-excursion
                (nnheader-set-temp-buffer " *acc*")
-               (insert-buffer-substring cur)
+               (insert-buffer-substring message-encoding-buffer)
+               (gnus-run-hooks 'gnus-before-do-gcc-hook)
                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")
@@ -1147,6 +1141,24 @@ this is a reply."
          (insert (car val) ": " (cdr val) "\n"))
        (gnus-pull (car val) gnus-message-style-insertions)))))
 
+
+;;; @ for MIME Edit mode
+;;;
+
+(defun gnus-maybe-setup-default-charset ()
+  (let ((charset
+        (and (boundp 'gnus-summary-buffer)
+              (buffer-live-p gnus-summary-buffer)
+             (save-excursion
+               (set-buffer gnus-summary-buffer)
+               default-mime-charset))))
+    (if charset
+       (progn
+         (make-local-variable 'default-mime-charset)
+         (setq default-mime-charset charset)
+         ))))
+
+
 ;;; Allow redefinition of functions.
 
 (gnus-ems-redefine)