Sync up with gnus-5.6.20
[elisp/gnus.git-] / lisp / gnus-msg.el
index c25fa17..0c830cb 100644 (file)
@@ -1,8 +1,8 @@
 ;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;         Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;        Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: mail, news, MIME
 
 (require 'message)
 (require 'gnus-art)
 
-;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(defvar gnus-post-method nil
+(defcustom gnus-post-method nil
   "*Preferred method for posting USENET news.
-If this variable is nil, Gnus will use the current method to decide
-which method to use when posting.  If it is non-nil, it will override
-the current method.  This method will not be used in mail groups and
-the like, only in \"real\" newsgroups.
 
-The value must be a valid method as discussed in the documentation of
-`gnus-select-method'.  It can also be a list of methods.  If that is
-the case, the user will be queried for what select method to use when
-posting.")
+If this variable is `current', Gnus will use the \"current\" select
+method when posting.  If it is nil (which is the default), Gnus will
+use the native posting method of the server.
+
+This method will not be used in mail groups and the like, only in
+\"real\" newsgroups.
+
+If not nil nor `native', the value must be a valid method as discussed
+in the documentation of `gnus-select-method'. It can also be a list of
+methods. If that is the case, the user will be queried for what select
+method to use when posting."
+  :group 'gnus-group-foreign
+  :type `(choice (const nil)
+                 (const current)
+                (const native)
+                (sexp :tag "Methods" ,gnus-select-method)))
 
 (defvar gnus-outgoing-message-group nil
   "*All outgoing messages will be put in this group.
@@ -88,6 +95,9 @@ the second with the current group name.")
 (defvar gnus-message-setup-hook nil
   "Hook run after setting up a message buffer.")
 
+(defvar gnus-bug-create-help-buffer t
+  "*Should we create the *Gnus Help Bug* buffer?")
+
 ;;; Internal variables.
 
 (defvar gnus-message-buffer "*Mail Gnus*")
@@ -158,10 +168,12 @@ Thank you for your help in stamping out bugs.
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
        (buffer (make-symbol "gnus-setup-message-buffer"))
-       (article (make-symbol "gnus-setup-message-article")))
+       (article (make-symbol "gnus-setup-message-article"))
+       (group (make-symbol "gnus-setup-message-group")))
     `(let ((,winconf (current-window-configuration))
           (,buffer (buffer-name (current-buffer)))
           (,article (and gnus-article-reply (gnus-summary-article-number)))
+          (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook)))
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
@@ -172,9 +184,9 @@ Thank you for your help in stamping out bugs.
         (gnus-inews-add-send-actions ,winconf ,buffer ,article)
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
-             (cons ,gnus-newsgroup-name ,article))
+             (cons ,group ,article))
         (make-local-variable 'gnus-newsgroup-name)
-        (run-hooks 'gnus-message-setup-hook))
+        (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-configure-windows ,config t)
        (set-buffer-modified-p nil))))
 
@@ -188,9 +200,9 @@ Thank you for your help in stamping out bugs.
   (message-add-action
    `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
   (message-add-action
-   `(when (buffer-name (get-buffer ,buffer))
+   `(when (gnus-buffer-exists-p ,buffer)
       (save-excursion
-       (set-buffer (get-buffer ,buffer))
+       (set-buffer ,buffer)
        ,(when article
           `(gnus-summary-mark-article-as-replied ,article))))
    'send))
@@ -312,9 +324,9 @@ header line with the old Message-ID."
       (message-supersede)
       (push
        `((lambda ()
-          (when (buffer-name (get-buffer ,gnus-summary-buffer))
+          (when (gnus-buffer-exists-p ,gnus-summary-buffer)
             (save-excursion
-              (set-buffer (get-buffer ,gnus-summary-buffer))
+              (set-buffer ,gnus-summary-buffer)
               (gnus-cache-possibly-remove-article ,article nil nil nil t)
               (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
        message-send-actions))))
@@ -333,7 +345,7 @@ header line with the old Message-ID."
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg contents)
     (if (not (and (get-buffer article-buffer)
-                 (buffer-name (get-buffer article-buffer))))
+                 (gnus-buffer-exists-p article-buffer)))
        (error "Can't find any article buffer")
       (save-excursion
        (set-buffer article-buffer)
@@ -402,6 +414,7 @@ header line with the old Message-ID."
            (if post
                (message-news (or to-group group))
              (set-buffer gnus-article-copy)
+             (gnus-msg-treat-broken-reply-to)
              (message-followup (if (or newsgroup-p force-news) nil to-group)))
          ;; The is mail.
          (if post
@@ -415,12 +428,19 @@ header line with the old Message-ID."
                  (push (list 'gnus-inews-add-to-address pgroup)
                        message-send-actions)))
            (set-buffer gnus-article-copy)
-           (message-wide-reply to-address
-                               (gnus-group-find-parameter
-                                gnus-newsgroup-name 'broken-reply-to))))
+           (gnus-msg-treat-broken-reply-to)
+           (message-wide-reply to-address)))
        (when yank
          (gnus-inews-yank-articles yank))))))
 
+(defun gnus-msg-treat-broken-reply-to ()
+  "Remove the Reply-to header iff broken-reply-to."
+  (when (gnus-group-find-parameter
+        gnus-newsgroup-name 'broken-reply-to)
+    (save-restriction
+      (message-narrow-to-head)
+      (message-remove-header "reply-to"))))
+
 (defun gnus-post-method (arg group &optional silent)
   "Return the posting method based on GROUP and ARG.
 If SILENT, don't prompt the user."
@@ -429,22 +449,28 @@ If SILENT, don't prompt the user."
      ;; If the group-method is nil (which shouldn't happen) we use
      ;; the default method.
      ((null group-method)
-      (or gnus-post-method gnus-select-method message-post-method))
-     ;; We want this group's method.
+      (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
+              gnus-select-method message-post-method))
+     ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
-      group-method)
+      (if (eq gnus-post-method 'active)
+         gnus-select-method
+       group-method))
      ;; We query the user for a post method.
      ((or arg
          (and gnus-post-method
+              (not (eq gnus-post-method 'current))
               (listp (car gnus-post-method))))
       (let* ((methods
              ;; Collect all methods we know about.
              (append
-              (when gnus-post-method
+              (when (and gnus-post-method
+                         (not (eq gnus-post-method 'current)))
                 (if (listp (car gnus-post-method))
                     gnus-post-method
                   (list gnus-post-method)))
               gnus-secondary-select-methods
+              (mapcar 'cdr gnus-server-alist)
               (list gnus-select-method)
               (list group-method)))
             method-alist post-methods method)
@@ -473,6 +499,9 @@ If SILENT, don't prompt the user."
                   (cons (or gnus-last-posting-server "") 0))))
          method-alist))))
      ;; Override normal method.
+     ((and (eq gnus-post-method 'current)
+          (not arg))
+      group-method) 
      (gnus-post-method
       gnus-post-method)
      ;; Use the normal select method.
@@ -488,40 +517,10 @@ If SILENT, don't prompt the user."
 ;;; 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"
+  "Stringified gnus version."
   (interactive)
   gnus-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)
-
 \f
 ;;;
 ;;; Gnus Mail Functions
@@ -543,8 +542,8 @@ automatically."
     (gnus-setup-message (if yank 'reply-yank 'reply)
       (gnus-summary-select-article)
       (set-buffer (gnus-copy-article-buffer))
-      (message-reply nil wide (gnus-group-find-parameter
-                              gnus-newsgroup-name 'broken-reply-to))
+      (gnus-msg-treat-broken-reply-to)
+      (message-reply nil wide)
       (when yank
        (gnus-inews-yank-articles yank)))))
 
@@ -575,7 +574,11 @@ 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))))
@@ -749,18 +752,20 @@ If YANK is non-nil, include the original article."
     (error "Gnus has been shut down"))
   (gnus-setup-message 'bug
     (delete-other-windows)
-    (switch-to-buffer (get-buffer-create "*Gnus Help Bug*"))
-    (erase-buffer)
-    (insert gnus-bug-message)
-    (goto-char (point-min))
+    (when gnus-bug-create-help-buffer
+      (switch-to-buffer "*Gnus Help Bug*")
+      (erase-buffer)
+      (insert gnus-bug-message)
+      (goto-char (point-min)))
     (message-pop-to-buffer "*Gnus Bug*")
     (message-setup `((To . ,gnus-maintainer) (Subject . "")))
-    (push `(gnus-bug-kill-buffer) message-send-actions)
+    (when gnus-bug-create-help-buffer
+      (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))
     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
     (forward-line 1)
-    (insert (gnus-version) "\n")
-    (insert (emacs-version) "\n")
+    (insert (gnus-version) "\n"
+           (emacs-version) "\n")
     (when (and (boundp 'nntp-server-type)
               (stringp nntp-server-type))
       (insert nntp-server-type))
@@ -896,7 +901,7 @@ this is a reply."
              (save-excursion
                (nnheader-set-temp-buffer " *acc*")
                (insert-buffer-substring message-encoding-buffer)
-               (run-hooks 'gnus-before-do-gcc-hook)
+               (gnus-run-hooks 'gnus-before-do-gcc-hook)
                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")