2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-msg.el
index b6f86ea..af72688 100644 (file)
@@ -112,7 +112,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)
@@ -216,6 +217,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
@@ -263,7 +265,16 @@ Thank you for your help in stamping out bugs.
        (setq mml-buffer-list nil)
        (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)
@@ -288,6 +299,7 @@ Thank you for your help in stamping out bugs.
           (setq mml-buffer-list mbl)))
        (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)
@@ -411,15 +423,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
@@ -431,10 +475,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.
@@ -581,7 +693,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))))
              (run-hooks 'gnus-article-decode-hook)))))
       gnus-article-copy)))
 
@@ -669,7 +782,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.
-         gnus-select-method 
+         gnus-select-method
          message-post-method))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
@@ -864,40 +977,45 @@ The original article will be yanked."
    (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
 
 (defun gnus-summary-mail-forward (&optional arg post)
-  "Forward the current message to another user.
-If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
+  "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;
+if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
 if ARG is 1, decode the message and forward directly inline;
 if ARG is 2, forward message as an rfc822 MIME section;
 if ARG is 3, decode message and forward as an rfc822 MIME section;
 if ARG is 4, forward message directly inline;
 otherwise, use flipped `message-forward-as-mime'.
-If POST, post instead of mail."
+If POST, post instead of mail.
+For the `inline' alternatives, also see the variable
+`message-forward-ignored-headers'."
   (interactive "P")
-  (let ((message-forward-as-mime message-forward-as-mime)
-       (message-forward-show-mml message-forward-show-mml))
-    (cond
-     ((null arg))
-     ((eq arg 1)
-      (setq message-forward-as-mime nil
-           message-forward-show-mml t))
-     ((eq arg 2)
-      (setq message-forward-as-mime t
-           message-forward-show-mml nil))
-     ((eq arg 3)
-      (setq message-forward-as-mime t
-           message-forward-show-mml t))
-     ((eq arg 4)
-      (setq message-forward-as-mime nil
-           message-forward-show-mml nil))
-     (t
-      (setq message-forward-as-mime (not message-forward-as-mime))))
-    (let ((gnus-article-reply (gnus-summary-article-number)))
-      (gnus-setup-message 'forward
-       (gnus-summary-select-article)
-       (let ((mail-parse-charset gnus-newsgroup-charset)
-             (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
-         (set-buffer gnus-original-article-buffer)
-         (message-forward post))))))
+  (if (null (cdr (gnus-summary-work-articles nil)))
+      (let ((message-forward-as-mime message-forward-as-mime)
+            (message-forward-show-mml message-forward-show-mml))
+        (cond
+         ((null arg))
+         ((eq arg 1)
+          (setq message-forward-as-mime nil
+                message-forward-show-mml t))
+         ((eq arg 2)
+          (setq message-forward-as-mime t
+                message-forward-show-mml nil))
+         ((eq arg 3)
+          (setq message-forward-as-mime t
+                message-forward-show-mml t))
+         ((eq arg 4)
+          (setq message-forward-as-mime nil
+                message-forward-show-mml nil))
+         (t
+          (setq message-forward-as-mime (not message-forward-as-mime))))
+        (let ((gnus-article-reply (gnus-summary-article-number)))
+          (gnus-setup-message 'forward
+            (gnus-summary-select-article)
+            (let ((mail-parse-charset gnus-newsgroup-charset)
+                  (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+              (set-buffer gnus-original-article-buffer)
+              (message-forward post)))))
+    (gnus-uu-digest-mail-forward arg post)))
 
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
@@ -972,12 +1090,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)
@@ -1253,12 +1365,12 @@ this is a reply."
                       ;; BUG: We really need to get the charset for
                       ;; each name in the Newsgroups and Followup-To
                       ;; lines to allow crossposting between group
-                      ;; namess with incompatible character sets.  
+                      ;; namess with incompatible character sets.
                       ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
                       (group-field-charset
                        (gnus-group-name-charset
                         method (or newsgroups-field "")))
-                      (followup-field-charset 
+                      (followup-field-charset
                        (gnus-group-name-charset
                         method (or followup-field "")))
                       (rfc2047-header-encoding-alist
@@ -1377,10 +1489,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)
@@ -1459,7 +1571,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
@@ -1491,7 +1604,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 ()
@@ -1503,7 +1617,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)))))
 
 ;;; Allow redefinition of functions.