Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-msg.el
index 0e1c853..51d8a53 100644 (file)
   "*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.
 
-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
-  :type `(choice (const nil)
+  :link '(custom-manual "(gnus)Posting Server")
+  :type `(choice (const native)
                 (const current)
-                (const native)
                 (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
-  "*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)
@@ -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
+  "i" gnus-summary-news-other-window
   "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)
-       (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)
@@ -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)
+       (run-hooks 'post-command-hook)
        (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))
                  ""))
+         ;; #### 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-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)
-  "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
@@ -439,10 +483,78 @@ If ARG is 1, prompt for a group 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.
@@ -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
-                  (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)
@@ -669,8 +782,7 @@ header line with the old Message-ID."
                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)))
@@ -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)
-      (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)))
-      (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
-         (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
-              (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)))
@@ -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))
-          (gnus-get-function group-method 'request-post t)
-          (not arg))
+          (gnus-get-function group-method 'request-post t))
+      (assert (not arg))
       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)
-     ;; Use the normal select method.
+     ;; Use the normal select method (nil or native).
      (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)
-  "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")
-  (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.
@@ -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)))))))
 
-(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)
@@ -1525,10 +1636,10 @@ this is a reply."
 
 ;;; 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
-    (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)
@@ -1607,7 +1718,8 @@ this is a reply."
       (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
@@ -1639,7 +1751,8 @@ this is a reply."
                           (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 ()
@@ -1651,7 +1764,8 @@ this is a reply."
                       (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