(gnus-setup-message): Setup `message-startup-parameter-alist'.
[elisp/gnus.git-] / lisp / gnus-msg.el
index 523dfd2..0feffe5 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.
 
@@ -167,8 +169,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
@@ -189,7 +191,11 @@ Thank you for your help in stamping out bugs.
           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
-          (message-mode-hook (copy-sequence message-mode-hook)))
+          (message-mode-hook (copy-sequence message-mode-hook))
+          (message-startup-parameter-alist
+           '((reply-buffer . gnus-copy-article-buffer)
+             (original-buffer . gnus-original-article-buffer)
+             (user-agent . Gnus))))
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
        (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
@@ -228,20 +234,11 @@ Thank you for your help in stamping out bugs.
 
 ;;; Post news commands of Gnus group mode and summary mode
 
-(defun gnus-group-mail (&optional arg)
-  "Start composing a mail.
-If ARG, use the group under the point to find a posting style.
-If ARG is 1, prompt for a group name to find the posting style."
-  (interactive "P")
-  (let ((gnus-newsgroup-name
-        (if arg
-            (if (= 1 (prefix-numeric-value arg))
-                (completing-read "Use posting style of group: "
-                                 gnus-active-hashtb nil
-                                 (gnus-read-active-file-p))
-              (gnus-group-group-name))
-          "")))
-    (gnus-setup-message 'message (message-mail))))
+(defun gnus-group-mail ()
+  "Start composing a mail."
+  (interactive)
+  (gnus-setup-message 'message
+    (message-mail)))
 
 (defun gnus-group-post-news (&optional arg)
   "Start composing a news message.
@@ -328,8 +325,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))
@@ -362,9 +361,7 @@ header line with the old Message-ID."
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
   ;; this buffer should be passed to all mail/news reply/post routines.
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
-  (save-excursion
-    (set-buffer gnus-article-copy)
-    (mm-enable-multibyte))
+  (buffer-disable-undo gnus-article-copy)
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)
@@ -398,7 +395,7 @@ header line with the old Message-ID."
                         (or (search-forward "\n\n" nil t) (point)))
          ;; Insert the original article headers.
          (insert-buffer-substring gnus-original-article-buffer beg end)
-         (article-decode-encoded-words)))
+         (gnus-article-decode-rfc1522)))
       gnus-article-copy)))
 
 (defun gnus-post-news (post &optional group header article-buffer yank subject
@@ -494,16 +491,14 @@ If SILENT, don't prompt the user."
                   (list gnus-post-method)))
               gnus-secondary-select-methods
               (mapcar 'cdr gnus-server-alist)
-              (mapcar 'car gnus-opened-servers)
               (list gnus-select-method)
               (list group-method)))
             method-alist post-methods method)
        ;; Weed out all mail methods.
        (while methods
          (setq method (gnus-server-get-method "" (pop methods)))
-         (when (and (or (gnus-method-option-p method 'post)
-                        (gnus-method-option-p method 'post-mail))
-                    (not (member method post-methods)))
+         (when (or (gnus-method-option-p method 'post)
+                   (gnus-method-option-p method 'post-mail))
            (push method post-methods)))
        ;; Create a name-method alist.
        (setq method-alist
@@ -527,7 +522,7 @@ If SILENT, don't prompt the user."
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))
           (not arg))
-      group-method)
+      group-method) 
      ((and gnus-post-method
           (not (eq gnus-post-method 'current)))
       gnus-post-method)
@@ -536,31 +531,17 @@ If SILENT, don't prompt the user."
 
 \f
 
-;; Dummies to avoid byte-compile warning.
+;; Dummy to avoid byte-compile warning.
 (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.
 (defun gnus-extended-version ()
-  "Stringified Gnus version and Emacs version."
+  "Stringified gnus version."
   (interactive)
-  (concat
-   "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
-   " (" gnus-version ")"
-   " "
-   (cond
-    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
-     (concat "Emacs/" (match-string 1 emacs-version)))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
-                  emacs-version)
-     (concat (match-string 1 emacs-version)
-            (format "/%d.%d" emacs-major-version emacs-minor-version)
-            (if (match-beginning 3)
-                (match-string 3 emacs-version)
-              "")
-            (if (boundp 'xemacs-codename)
-                (concat " (" xemacs-codename ")")
-              "")))
-    (t emacs-version))))
+  gnus-version)
 
 \f
 ;;;
@@ -615,11 +596,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")
@@ -631,12 +649,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.
@@ -668,8 +680,7 @@ The current group name will be inserted at \"%s\".")
        (gnus-summary-select-article)
        (set-buffer gnus-original-article-buffer)
        (if (and (<= (length (message-tokenize-header
-                             (setq newsgroups
-                                   (mail-fetch-field "newsgroups"))
+                             (setq newsgroups (mail-fetch-field "newsgroups"))
                              ", "))
                     1)
                 (or (not (setq followup-to (mail-fetch-field "followup-to")))
@@ -832,6 +843,7 @@ The source file has to be in the Emacs load path."
     ;; Go through all the files looking for non-default values for variables.
     (save-excursion
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
+      (buffer-disable-undo (current-buffer))
       (while files
        (erase-buffer)
        (when (and (setq file (locate-library (pop files)))
@@ -909,7 +921,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")
@@ -937,13 +949,14 @@ 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) "$")
                       nil t)
                  (replace-match "" t t ))
-               (unless (gnus-request-accept-article group method t t)
+               (unless (gnus-request-accept-article group method t)
                  (gnus-message 1 "Couldn't store article in group %s: %s"
                                group (gnus-status-message method))
                  (sit-for 2))
@@ -974,7 +987,7 @@ this is a reply."
          (and gnus-newsgroup-name
               (gnus-group-find-parameter
                gnus-newsgroup-name 'gcc-self)))
-        result
+        result 
         (groups
          (cond
           ((null gnus-message-archive-method)
@@ -1078,7 +1091,7 @@ this is a reply."
            (if (and (not (stringp (car attribute)))
                     (not (eq 'body (car attribute)))
                     (not (setq variable
-                               (cdr (assq (car attribute)
+                               (cdr (assq (car attribute) 
                                           gnus-posting-style-alist)))))
                (message "Couldn't find attribute %s" (car attribute))
              ;; We get the value.