Merge from emacs--devo--0
[gnus] / lisp / gnus-msg.el
index fd058fa..26021e9 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
 
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -11,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -109,6 +109,7 @@ the second with the current group name."
 (defcustom gnus-message-setup-hook nil
   "Hook run after setting up a message buffer."
   :group 'gnus-message
+  :options '(message-remove-blank-cited-lines)
   :type 'hook)
 
 (defcustom gnus-bug-create-help-buffer t
@@ -261,15 +262,15 @@ See also the `mml-default-encrypt-method' variable."
 This is done because new users often reply by mistake when reading
 news.
 This can also be a function receiving the group name as the only
-parameter which should return non-nil iff a confirmation is needed, or
-a regexp, in which case a confirmation is asked for iff the group name
+parameter, which should return non-nil if a confirmation is needed; or
+a regexp, in which case a confirmation is asked for if the group name
 matches the regexp."
-  :version "22.1"
+  :version "23.0" ;; No Gnus (default changed)
   :group 'gnus-message
   :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t)
-                (regexp :tag "Iff group matches regexp")
-                (function :tag "Iff function evaluates to non-nil")))
+                (regexp :tag "If group matches regexp")
+                (function :tag "If function evaluates to non-nil")))
 
 (defcustom gnus-confirm-treat-mail-like-news
   nil
@@ -379,7 +380,7 @@ Thank you for your help in stamping out bugs.
 (defun gnus-inews-make-draft (articles)
   `(lambda ()
      (gnus-inews-make-draft-meta-information
-      ,gnus-newsgroup-name ',articles)))
+      ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
 
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
@@ -400,6 +401,13 @@ 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)
+       ;; message-newsreader and message-mailer were formerly set in
+       ;; gnus-inews-add-send-actions, but this is too late when
+       ;; message-generate-headers-first is used. --ansel
+       (add-hook 'message-mode-hook
+                (lambda nil
+                  (setq message-newsreader
+                        (setq message-mailer (gnus-extended-version)))))
        ;; #### 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'.
@@ -532,7 +540,6 @@ Gcc: header for archiving purposes."
   (setq message-post-method
        `(lambda (&optional arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))
-  (setq message-newsreader (setq message-mailer (gnus-extended-version)))
   (message-add-action
    `(when (gnus-buffer-exists-p ,buffer)
       (set-window-configuration ,winconf))
@@ -574,9 +581,9 @@ If ARG is 1, prompt for a group name to find the posting style."
          (setq gnus-newsgroup-name
                (if arg
                    (if (= 1 (prefix-numeric-value arg))
-                       (completing-read "Use posting style of group: "
-                                        gnus-active-hashtb nil
-                                        (gnus-read-active-file-p))
+                       (gnus-group-completing-read
+                        "Use posting style of group: "
+                        nil nil (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))
          ;; #### see comment in gnus-setup-message -- drv
@@ -605,9 +612,9 @@ network.  The corresponding back end must have a 'request-post method."
          (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-completing-read "Use group: "
+                                                   nil nil
+                                                   (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))
          ;; #### see comment in gnus-setup-message -- drv
@@ -627,8 +634,8 @@ a news."
   (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-group-completing-read "Newsgroup: " nil nil
+                                            (gnus-read-active-file-p))
               (gnus-group-group-name))
           ""))
        ;; make sure last viewed article doesn't affect posting styles:
@@ -653,9 +660,9 @@ posting style."
          (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-completing-read "Use group: "
+                                                   nil nil
+                                                   (gnus-read-active-file-p))
                      "")
                  gnus-newsgroup-name))
          ;; #### see comment in gnus-setup-message -- drv
@@ -684,9 +691,9 @@ network.  The corresponding back end must have a 'request-post method."
          (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-completing-read "Use group: "
+                                                   nil nil
+                                                   (gnus-read-active-file-p))
                      "")
                  gnus-newsgroup-name))
          ;; #### see comment in gnus-setup-message -- drv
@@ -711,8 +718,8 @@ a news."
   (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-group-completing-read "Newsgroup: " nil nil
+                                            (gnus-read-active-file-p))
               "")
           gnus-newsgroup-name))
        ;; make sure last viewed article doesn't affect posting styles:
@@ -783,6 +790,7 @@ active, the entire article will be yanked."
                 (nnheader-narrow-to-headers)
                 (nnheader-parse-naked-head)))))
        (message-yank-original)
+       (message-exchange-point-and-mark)
        (setq beg (or beg (mark t))))
       (when articles
        (insert "\n")))
@@ -824,7 +832,10 @@ header line with the old Message-ID."
               (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))))
+       message-send-actions)
+      ;; Add Gcc header.
+      (gnus-inews-insert-archive-gcc)
+      (gnus-inews-insert-gcc))))
 
 \f
 
@@ -1090,7 +1101,10 @@ If VERY-WIDE, make a very wide reply."
                       ((functionp gnus-confirm-mail-reply-to-news)
                        (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
                       (t gnus-confirm-mail-reply-to-news)))
-           (y-or-n-p "Really reply by mail to article author? "))
+           (if (or wide very-wide)
+               t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
+                 ;; wide replies.
+             (y-or-n-p "Really reply by mail to article author? ")))
     (let* ((article
            (if (listp (car yank))
                (caar yank)
@@ -1287,10 +1301,13 @@ composing a new message."
        (message-narrow-to-head-1)
        ;; Gnus will generate a new one when sending.
        (message-remove-header "Message-ID")
-       (message-remove-header message-ignored-resent-headers t)
        ;; Remove unwanted headers.
+       (message-remove-header message-ignored-resent-headers t)
        (goto-char (point-max))
        (insert mail-header-separator)
+       ;; Add Gcc header.
+       (gnus-inews-insert-archive-gcc)
+       (gnus-inews-insert-gcc)
        (goto-char (point-min))
        (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
          (forward-char 1))
@@ -1562,15 +1579,29 @@ If FETCH, try to fetch the article that this is a reply to, if indeed
 this is a reply."
   (interactive "P")
   (gnus-summary-select-article t)
-  (set-buffer gnus-original-article-buffer)
-  (gnus-setup-message 'compose-bounce
-    (let* ((references (mail-fetch-field "references"))
-          (parent (and references (gnus-parent-id references))))
+  (let (summary-buffer parent)
+    (if fetch
+       (progn
+         (setq summary-buffer (current-buffer))
+         (set-buffer gnus-original-article-buffer)
+         (article-goto-body)
+         (when (re-search-forward "^References:\n?" nil t)
+           (while (memq (char-after) '(?\t ? ))
+             (forward-line 1))
+           (skip-chars-backward "\t\n ")
+           (setq parent
+                 (gnus-parent-id (buffer-substring (match-end 0) (point))))))
+      (set-buffer gnus-original-article-buffer))
+    (gnus-setup-message 'compose-bounce
       (message-bounce)
+      ;; Add Gcc header.
+      (gnus-inews-insert-archive-gcc)
+      (gnus-inews-insert-gcc)
       ;; If there are references, we fetch the article we answered to.
-      (and fetch parent
-          (gnus-summary-refer-article parent)
-          (gnus-summary-show-all-headers)))))
+      (when parent
+       (with-current-buffer summary-buffer
+         (gnus-summary-refer-article parent)
+         (gnus-summary-show-all-headers))))))
 
 ;;; Gcc handling.
 
@@ -1605,8 +1636,11 @@ this is a reply."
                        (message-tokenize-header gcc " ,")))
          ;; Copy the article over to some group(s).
          (while (setq group (pop groups))
-           (unless (gnus-check-server
-                    (setq method (gnus-inews-group-method group)))
+           (setq method (gnus-inews-group-method group)
+                 group (mm-encode-coding-string
+                        group
+                        (gnus-group-name-charset method group)))
+           (unless (gnus-check-server method)
              (error "Can't open server %s" (if (stringp method) method
                                              (car method))))
            (unless (gnus-request-group group nil method)
@@ -1696,8 +1730,13 @@ this is a reply."
 
 (defun gnus-inews-insert-archive-gcc (&optional group)
   "Insert the Gcc to say where the article is to be archived."
+  (setq group (cond (group
+                    (gnus-group-decoded-name group))
+                   (gnus-newsgroup-name
+                    (gnus-group-decoded-name gnus-newsgroup-name))
+                   (t
+                    "")))
   (let* ((var gnus-message-archive-group)
-        (group (or group gnus-newsgroup-name ""))
         (gcc-self-val
          (and gnus-newsgroup-name
               (not (equal gnus-newsgroup-name ""))
@@ -1879,6 +1918,13 @@ this is a reply."
             ((eq element 'x-face-file)
              (setq element 'x-face
                    filep t)))
+           ;; Post-processing for the signature posting-style:
+           (and (eq element 'signature) filep
+                message-signature-directory
+                ;; don't actually use the signature directory
+                ;; if message-signature-file contains a path.
+                (not (file-name-directory v))
+                (setq v (nnheader-concat message-signature-directory v)))
            ;; Get the contents of file elems.
            (when (and filep v)
              (setq v (with-temp-buffer