Synch with Oort Gnus.

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

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 9c8c54c..51d8a53 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -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)

@@ -724,7 +837,7 @@ If SILENT, don't prompt the user."
       (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.
       (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 
+         gnus-select-method

          message-post-method))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
          message-post-method))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))

@@ -975,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.

@@ -1119,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)

@@ -1526,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)

@@ -1608,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

@@ -1640,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 ()

@@ -1652,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