Synch with Oort Gnus.

[elisp/gnus.git-] / lisp / gnus-msg.el

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 0e1c853..51d8a53 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -43,20 +43,20 @@
   "*Preferred method for posting USENET news.
 
 If this variable is `current' (which is the default), Gnus will use
   "*Preferred method for posting USENET news.
 
 If this variable is `current' (which is the default), Gnus will use

-the \"current\" select method when posting.  If it is nil, Gnus will
-use the native select method when posting.
+the \"current\" select method when posting.  If it is `native', Gnus
+will use the native select method when posting.

 
 This method will not be used in mail groups and the like, only in
 \"real\" newsgroups.
 
 
 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
+If not `native' nor `current', 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
 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)
+  :link '(custom-manual "(gnus)Posting Server")
+  :type `(choice (const native)

                 (const current)
                 (const current)

-                (const native)

                 (sexp :tag "Methods" ,gnus-select-method)))
 
 (defcustom gnus-outgoing-message-group nil
                 (sexp :tag "Methods" ,gnus-select-method)))
 
 (defcustom gnus-outgoing-message-group nil

@@ -117,7 +117,8 @@ the second with the current group name."
   :type 'boolean)
 
 (defcustom gnus-posting-styles nil
   :type 'boolean)
 
 (defcustom gnus-posting-styles nil

-  "*Alist of styles to use when posting."
+  "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."

   :group 'gnus-message
   :type '(repeat (cons (choice (regexp)
                               (function)
   :group 'gnus-message
   :type '(repeat (cons (choice (regexp)
                               (function)

@@ -233,6 +234,7 @@ Thank you for your help in stamping out bugs.
 
 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
   "p" gnus-summary-post-news
 
 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
   "p" gnus-summary-post-news

+  "i" gnus-summary-news-other-window

   "f" gnus-summary-followup
   "F" gnus-summary-followup-with-original
   "c" gnus-summary-cancel-article
   "f" gnus-summary-followup
   "F" gnus-summary-followup-with-original
   "c" gnus-summary-cancel-article

@@ -282,7 +284,16 @@ Thank you for your help in stamping out bugs.
              (user-agent . Gnus))))
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
              (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)
+       ;; #### FIXME: for a reason that I did not manage to identify yet,
+       ;; the variable `gnus-newsgroup-name' does not honor a dynamically
+       ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
+       ;; After evaluation of @forms below, it gets the value we actually want
+       ;; to override, and the posting styles are used. For that reason, I've
+       ;; added an optional argument to `gnus-configure-posting-styles' to
+       ;; make sure that the correct value for the group name is used. -- drv
+       (add-hook 'message-mode-hook
+                (lambda ()
+                  (gnus-configure-posting-styles ,group)))

        (unwind-protect
           (progn
             ,@forms)
        (unwind-protect
           (progn
             ,@forms)

@@ -295,6 +306,7 @@ Thank you for your help in stamping out bugs.
         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)

+       (run-hooks 'post-command-hook)

        (set-buffer-modified-p nil))))
 
 (defun gnus-inews-insert-draft-meta-information (group article)
        (set-buffer-modified-p nil))))
 
 (defun gnus-inews-insert-draft-meta-information (group article)

@@ -419,15 +431,47 @@ If ARG is 1, prompt for a group name to find the posting style."
                                         (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))
                                         (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))

+         ;; #### see comment in gnus-setup-message -- drv

          (gnus-setup-message 'message (message-mail)))
       (save-excursion
        (set-buffer buffer)
        (setq gnus-newsgroup-name group)))))
 
          (gnus-setup-message 'message (message-mail)))
       (save-excursion
        (set-buffer buffer)
        (setq gnus-newsgroup-name group)))))
 

+(defun gnus-group-news (&optional arg)
+  "Start composing a news.
+If ARG, post to group under point.
+If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups.  This is useful
+for posting messages to mail groups without actually sending them over the
+network.  The corresponding backend must have a 'request-post method."
+  (interactive "P")
+  ;; We can't `let' gnus-newsgroup-name here, since that leads
+  ;; to local variables leaking.
+  (let ((group gnus-newsgroup-name)
+       (buffer (current-buffer)))
+    (unwind-protect
+       (progn
+         (setq gnus-newsgroup-name
+               (if arg
+                   (if (= 1 (prefix-numeric-value arg))
+                       (completing-read "Use group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     (gnus-group-group-name))
+                 ""))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message
+           (message-news (gnus-group-real-name gnus-newsgroup-name))))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+

 (defun gnus-group-post-news (&optional arg)
 (defun gnus-group-post-news (&optional arg)

-  "Start composing a news message.
-If ARG, post to the group under point.
-If ARG is 1, prompt for a group name."
+  "Start composing a message (a news by default).
+If ARG, post to group under point.  If ARG is 1, prompt for group name.
+Depending on the selected group, the message might be either a mail or
+a news."

   (interactive "P")
   ;; Bind this variable here to make message mode hooks work ok.
   (let ((gnus-newsgroup-name
   (interactive "P")
   ;; Bind this variable here to make message mode hooks work ok.
   (let ((gnus-newsgroup-name

@@ -439,10 +483,78 @@ If ARG is 1, prompt for a group name."
           "")))
     (gnus-post-news 'post gnus-newsgroup-name)))
 
           "")))
     (gnus-post-news 'post gnus-newsgroup-name)))
 

-(defun gnus-summary-post-news ()
-  "Start composing a news message."
-  (interactive)
-  (gnus-post-news 'post gnus-newsgroup-name))
+(defun gnus-summary-mail-other-window (&optional arg)
+  "Start composing a mail in another window.
+Use the posting of the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for group name to find the
+posting style."
+  (interactive "P")
+  ;; We can't `let' gnus-newsgroup-name here, since that leads
+  ;; to local variables leaking.
+  (let ((group gnus-newsgroup-name)
+       (buffer (current-buffer)))
+    (unwind-protect
+       (progn
+         (setq gnus-newsgroup-name
+               (if arg
+                   (if (= 1 (prefix-numeric-value arg))
+                       (completing-read "Use group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     "")
+                 gnus-newsgroup-name))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message (message-mail)))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-news-other-window (&optional arg)
+  "Start composing a news in another window.
+Post to the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups.  This is useful
+for posting messages to mail groups without actually sending them over the
+network.  The corresponding backend must have a 'request-post method."
+  (interactive "P")
+  ;; We can't `let' gnus-newsgroup-name here, since that leads
+  ;; to local variables leaking.
+  (let ((group gnus-newsgroup-name)
+       (buffer (current-buffer)))
+    (unwind-protect
+       (progn
+         (setq gnus-newsgroup-name
+               (if arg
+                   (if (= 1 (prefix-numeric-value arg))
+                       (completing-read "Use group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     "")
+                 gnus-newsgroup-name))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message
+           (message-news (gnus-group-real-name gnus-newsgroup-name))))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-post-news (&optional arg)
+  "Start composing a message.  Post to the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for a group name to post to.
+Depending on the selected group, the message might be either a mail or
+a news."
+  (interactive "P")
+  ;; Bind this variable here to make message mode hooks work ok.
+  (let ((gnus-newsgroup-name
+        (if arg
+            (if (= 1 (prefix-numeric-value arg))
+                (completing-read "Newsgroup: " gnus-active-hashtb nil
+                                 (gnus-read-active-file-p))
+              "")
+          gnus-newsgroup-name)))
+    (gnus-post-news 'post gnus-newsgroup-name)))
+

 
 (defun gnus-summary-followup (yank &optional force-news)
   "Compose a followup to an article.
 
 (defun gnus-summary-followup (yank &optional force-news)
   "Compose a followup to an article.

@@ -633,7 +745,8 @@ header line with the old Message-ID."
            (insert-buffer-substring gnus-original-article-buffer beg end)
            ;; Decode charsets.
            (let ((gnus-article-decode-hook
            (insert-buffer-substring gnus-original-article-buffer beg end)
            ;; Decode charsets.
            (let ((gnus-article-decode-hook

-                  (delq 'article-decode-charset gnus-article-decode-hook)))
+                  (delq 'article-decode-charset
+                        (copy-sequence gnus-article-decode-hook))))

              ;; Needed for T-gnus.
              (add-hook 'gnus-article-decode-hook
                        'article-decode-encoded-words)
              ;; Needed for T-gnus.
              (add-hook 'gnus-article-decode-hook
                        'article-decode-encoded-words)

@@ -669,8 +782,7 @@ header line with the old Message-ID."
                force-news
                (and (gnus-news-group-p
                      (or pgroup gnus-newsgroup-name)
                force-news
                (and (gnus-news-group-p
                      (or pgroup gnus-newsgroup-name)

-                     (if header (mail-header-number header)
-                       gnus-current-article))
+                     (or header gnus-current-article))

                     (not mailing-list)
                     (not to-list)
                     (not to-address)))
                     (not mailing-list)
                     (not to-list)
                     (not to-address)))

@@ -722,23 +834,24 @@ 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)
      ;; If the group-method is nil (which shouldn't happen) we use
      ;; the default method.
      ((null group-method)

-      (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
-         gnus-select-method message-post-method))
+      (or (and (listp gnus-post-method)        ;If not current/native/nil
+              (not (listp (car gnus-post-method))) ; and not a list of methods
+              gnus-post-method)        ;then use it.
+         gnus-select-method
+         message-post-method))

      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))

-      (if (eq gnus-post-method 'active)
+      (if (eq gnus-post-method 'current)

          gnus-select-method
        group-method))
      ;; We query the user for a post method.
      ((or arg
          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))
+         (and (listp gnus-post-method)

               (listp (car gnus-post-method))))
       (let* ((methods
              ;; Collect all methods we know about.
              (append
               (listp (car gnus-post-method))))
       (let* ((methods
              ;; Collect all methods we know about.
              (append

-              (when (and gnus-post-method
-                         (not (eq gnus-post-method 'current)))
+              (when (listp gnus-post-method)

                 (if (listp (car gnus-post-method))
                     gnus-post-method
                   (list gnus-post-method)))
                 (if (listp (car gnus-post-method))
                     gnus-post-method
                   (list gnus-post-method)))

@@ -778,13 +891,14 @@ If SILENT, don't prompt the user."
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))

-          (gnus-get-function group-method 'request-post t)
-          (not arg))
+          (gnus-get-function group-method 'request-post t))
+      (assert (not arg))

       group-method)
       group-method)

-     ((and gnus-post-method
-          (not (eq gnus-post-method 'current)))
+     ;; Use gnus-post-method.
+     ((listp gnus-post-method)         ;A method...
+      (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.

       gnus-post-method)
       gnus-post-method)

-     ;; Use the normal select method.
+     ;; Use the normal select method (nil or native).

      (t gnus-select-method))))
 
 \f
      (t gnus-select-method))))
 
 \f

@@ -974,18 +1088,21 @@ The original article will be yanked."
    (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
 
 (defun gnus-summary-mail-forward (&optional full-headers post)
    (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
 
 (defun gnus-summary-mail-forward (&optional full-headers post)

-  "Forward the current message to another user.
+  "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;

 If FULL-HEADERS (the prefix), include full headers when forwarding."
   (interactive "P")
 If FULL-HEADERS (the prefix), include full headers when forwarding."
   (interactive "P")

-  (gnus-setup-message 'forward
-    (gnus-summary-select-article)
-    (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))))
+  (if (null (cdr (gnus-summary-work-articles nil)))
+      (gnus-setup-message 'forward
+       (gnus-summary-select-article)
+       (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)))
+    (gnus-summary-digest-mail-forward nil post)))

 
 (defun gnus-summary-digest-mail-forward (&optional n post)
   "Digests and forwards all articles in this series.
 
 (defun gnus-summary-digest-mail-forward (&optional n post)
   "Digests and forwards all articles in this series.

@@ -1118,12 +1235,6 @@ The current group name will be inserted at \"%s\".")
          (when (gnus-y-or-n-p "Send this complaint? ")
            (message-send-and-exit)))))))
 
          (when (gnus-y-or-n-p "Send this complaint? ")
            (message-send-and-exit)))))))
 

-(defun gnus-summary-mail-other-window ()
-  "Compose mail in other window."
-  (interactive)
-  (gnus-setup-message 'message
-    (message-mail)))
-

 (defun gnus-mail-parse-comma-list ()
   (let (accumulated
        beg)
 (defun gnus-mail-parse-comma-list ()
   (let (accumulated
        beg)

@@ -1525,10 +1636,10 @@ this is a reply."
 
 ;;; Posting styles.
 
 
 ;;; Posting styles.
 

-(defun gnus-configure-posting-styles ()
+(defun gnus-configure-posting-styles (&optional group-name)

   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles

-    (let ((group (or gnus-newsgroup-name ""))
+    (let ((group (or group-name gnus-newsgroup-name ""))

          (styles gnus-posting-styles)
          style match variable attribute value v results
          filep name address element)
          (styles gnus-posting-styles)
          style match variable attribute value v results
          filep name address element)

@@ -1607,7 +1718,8 @@ this is a reply."
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))

-      (make-local-variable 'message-setup-hook)
+      ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
+      (make-local-hook 'message-setup-hook)

       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond
       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond

@@ -1639,7 +1751,8 @@ this is a reply."
                           (let ((value ,(cdr result)))
                             (when value
                               (message-goto-eoh)
                           (let ((value ,(cdr result)))
                             (when value
                               (message-goto-eoh)

-                              (insert ,header ": " value "\n"))))))))))
+                              (insert ,header ": " value "\n"))))))))
+                 nil 'local))

       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()
       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()

@@ -1651,7 +1764,8 @@ this is a reply."
                       (save-excursion
                         (message-remove-header "From")
                         (message-goto-eoh)
                       (save-excursion
                         (message-remove-header "From")
                         (message-goto-eoh)

-                        (insert "From: " (message-make-from) "\n")))))))))
+                        (insert "From: " (message-make-from) "\n"))))
+                 nil 'local)))))

 
 
 ;;; @ for MIME Edit mode
 
 
 ;;; @ for MIME Edit mode