Merge from emacs--devo--0
[gnus] / lisp / gnus-msg.el
index 84b1701..555b6a0 100644 (file)
@@ -1,6 +1,7 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -8,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -66,8 +65,10 @@ message in, you can set this variable to a function that checks the
 current newsgroup name and then returns a suitable group name (or list
 of names)."
   :group 'gnus-message
-  :type '(choice (string :tag "Group")
-                (function)))
+  :type '(choice (const nil)
+                (function)
+                (string :tag "Group")
+                (repeat :tag "List of groups" (string :tag "Group"))))
 
 (defcustom gnus-mailing-list-groups nil
   "*If non-nil a regexp matching groups that are really mailing lists.
@@ -106,6 +107,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
@@ -142,13 +144,10 @@ See Info node `(gnus)Posting Styles'."
 
 (defcustom gnus-gcc-mark-as-read nil
   "If non-nil, automatically mark Gcc articles as read."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-message
   :type 'boolean)
 
-(defvar gnus-inews-mark-gcc-as-read nil
-  "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
-
 (make-obsolete-variable 'gnus-inews-mark-gcc-as-read
                        'gnus-gcc-mark-as-read)
 
@@ -157,7 +156,7 @@ See Info node `(gnus)Posting Styles'."
 If it is `all', attach files as external parts;
 if a regexp and matches the Gcc group name, attach files as external parts;
 if nil, attach files as normal parts."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-message
   :type '(choice (const nil :tag "None")
                 (const all :tag "Any")
@@ -215,7 +214,7 @@ List of charsets that are permitted to be unencoded.")
     "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
     "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
   "Files whose variables will be reported in `gnus-bug'."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-message
   :type '(repeat (string :tag "File")))
 
@@ -223,7 +222,7 @@ List of charsets that are permitted to be unencoded.")
   '(mm-mime-mule-charset-alist
     nnmail-split-fancy message-minibuffer-local-map)
   "Variables that should not be reported in `gnus-bug'."
-  :version "21.1"
+  :version "22.1"
   :group 'gnus-message
   :type '(repeat (symbol :tag "Variable")))
 
@@ -231,7 +230,7 @@ List of charsets that are permitted to be unencoded.")
   '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
   "A list of back ends that are not used in \"real\" newsgroups.
 This variable is used only when `gnus-post-method' is `current'."
-  :version "21.3"
+  :version "22.1"
   :group 'gnus-group-foreign
   :type '(repeat (symbol :tag "Back end")))
 
@@ -251,23 +250,25 @@ See also the `mml-default-encrypt-method' variable."
 
 (defcustom gnus-message-replysignencrypted
   t
-  "Setting this causes automatically encryped messages to also be signed."
+  "Setting this causes automatically encrypted messages to also be signed."
   :group 'gnus-message
   :type 'boolean)
 
-(defcustom gnus-confirm-mail-reply-to-news nil
+(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user
+                                               (not gnus-expert-user))
   "If non-nil, Gnus requests confirmation when replying to news.
 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 "23.1" ;; 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
@@ -275,6 +276,7 @@ matches the regexp."
 when replying by mail.  See the `gnus-confirm-mail-reply-to-news' variable
 for fine-tuning this.
 If nil, Gnus will never ask for confirmation if replying to mail."
+  :version "22.1"
   :group 'gnus-message
   :type 'boolean)
 
@@ -282,26 +284,19 @@ If nil, Gnus will never ask for confirmation if replying to mail."
   "If non-nil, Gnus tries to suggest a default address to resend to.
 If nil, the address field will always be empty after invoking
 `gnus-summary-resend-message'."
+  :version "22.1"
   :group 'gnus-message
   :type 'boolean)
 
-(defcustom gnus-user-agent 'emacs-gnus-type
-  "Which information should be exposed in the User-Agent header.
-
-It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
-\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
-`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
-`emacs-gnus' plus system type\) or a custom string.  If you set it to a
-string, be sure to use a valid format, see RFC 2616."
+(defcustom gnus-message-highlight-citation
+  t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
+  "Enable highlighting of different citation levels in message-mode."
+  :version "23.1" ;; No Gnus
+  :group 'gnus-cite
   :group 'gnus-message
-  :type '(choice
-         (item :tag "Show Gnus and Emacs versions and system type"
-               emacs-gnus-type)
-         (item :tag "Show Gnus and Emacs versions and system configuration"
-               emacs-gnus-config)
-         (item :tag "Show Gnus and Emacs versions" emacs-gnus)
-         (item :tag "Show only Gnus version" gnus)
-         (string :tag "Other")))
+  :type 'boolean)
+
+(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
 
 ;;; Internal variables.
 
@@ -338,12 +333,7 @@ Please describe the bug in annoying, painstaking detail.
 Thank you for your help in stamping out bugs.
 ")
 
-(eval-and-compile
-  (autoload 'gnus-uu-post-news "gnus-uu" nil t)
-  (autoload 'news-setup "rnewspost")
-  (autoload 'news-reply-mode "rnewspost")
-  (autoload 'rmail-dont-reply-to "mail-utils")
-  (autoload 'rmail-output "rmailout"))
+(autoload 'gnus-uu-post-news "gnus-uu" nil t)
 
 \f
 ;;;
@@ -384,10 +374,10 @@ Thank you for your help in stamping out bugs.
 
 ;;; Internal functions.
 
-(defun gnus-inews-make-draft ()
+(defun gnus-inews-make-draft (articles)
   `(lambda ()
      (gnus-inews-make-draft-meta-information
-      ,gnus-newsgroup-name ',gnus-article-reply)))
+      ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
 
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
@@ -408,6 +398,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'.
@@ -416,15 +413,20 @@ Thank you for your help in stamping out bugs.
        ;; 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)))
+                (if (memq ,config '(reply-yank reply))
+                    (lambda ()
+                      (gnus-configure-posting-styles ,group))
+                  (lambda ()
+                    ;; There may be an old " *gnus article copy*" buffer.
+                    (let (gnus-article-copy)
+                      (gnus-configure-posting-styles ,group)))))
        (gnus-pull ',(intern gnus-draft-meta-information-header)
                  message-required-headers)
        (when (and ,group
                  (not (string= ,group "")))
         (push (cons
                (intern gnus-draft-meta-information-header)
-               (gnus-inews-make-draft))
+               (gnus-inews-make-draft (or ,yanked ,article)))
               message-required-headers))
        (unwind-protect
           (progn
@@ -435,15 +437,16 @@ Thank you for your help in stamping out bugs.
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
         (set (make-local-variable 'gnus-newsgroup-name) ,group)
+        ;; Enable highlighting of different citation levels
+        (when gnus-message-highlight-citation
+          (gnus-message-citation-mode 1))
         (gnus-run-hooks 'gnus-message-setup-hook)
         (if (eq major-mode 'message-mode)
             (let ((mbl1 mml-buffer-list))
               (setq mml-buffer-list mbl)  ;; Global value
               (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
-              ;; LOCAL argument of add-hook differs between GNU Emacs
-              ;; and XEmacs. make-local-hook makes sure they are local.
-              (make-local-hook 'kill-buffer-hook)
-              (make-local-hook 'change-major-mode-hook)
+              (gnus-make-local-hook 'kill-buffer-hook)
+              (gnus-make-local-hook 'change-major-mode-hook)
               (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
               (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
           (mml-destroy-buffers)
@@ -454,12 +457,20 @@ Thank you for your help in stamping out bugs.
        (run-hooks 'post-command-hook)
        (set-buffer-modified-p nil))))
 
-(defun gnus-inews-make-draft-meta-information (group article)
-  (concat "(\"" group "\" "
-         (if article (number-to-string
-                      (if (listp article)
-                          (car article)
-                        article)) "\"\"")
+(defun gnus-inews-make-draft-meta-information (group articles)
+  (when (numberp articles)
+    (setq articles (list articles)))
+  (concat "(\"" group "\""
+         (if articles
+             (concat " "
+                     (mapconcat
+                      (lambda (elem)
+                        (number-to-string
+                         (if (consp elem)
+                             (car elem)
+                           elem)))
+                      articles " "))
+           "")
          ")"))
 
 ;;;###autoload
@@ -481,27 +492,19 @@ Gcc: header for archiving purposes."
   ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
   t)
 
-(defvar save-selected-window-window)
-
 ;;;###autoload
 (defun gnus-button-mailto (address)
   "Mail to ADDRESS."
   (set-buffer (gnus-copy-article-buffer))
   (gnus-setup-message 'message
-    (message-reply address))
-  (and (boundp 'save-selected-window-window)
-       (not (window-live-p save-selected-window-window))
-       (setq save-selected-window-window (selected-window))))
+    (message-reply address)))
 
 ;;;###autoload
 (defun gnus-button-reply (&optional to-address wide)
   "Like `message-reply'."
   (interactive)
   (gnus-setup-message 'message
-    (message-reply to-address wide))
-  (and (boundp 'save-selected-window-window)
-       (not (window-live-p save-selected-window-window))
-       (setq save-selected-window-window (selected-window))))
+    (message-reply to-address wide)))
 
 ;;;###autoload
 (define-mail-user-agent 'gnus-user-agent
@@ -517,7 +520,7 @@ Gcc: header for archiving purposes."
        (while (setq elem (pop alist))
          (when (or (and (stringp (car elem))
                         (string-match (car elem) group))
-                   (and (gnus-functionp (car elem))
+                   (and (functionp (car elem))
                         (funcall (car elem) group))
                    (and (symbolp (car elem))
                         (symbol-value (car elem))))
@@ -525,28 +528,28 @@ Gcc: header for archiving purposes."
 
 (defun gnus-inews-add-send-actions (winconf buffer article
                                            &optional config yanked)
-  (make-local-hook 'message-sent-hook)
+  (gnus-make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
                                 'gnus-inews-do-gcc) nil t)
   (when gnus-agent
-    (make-local-hook 'message-header-hook)
+    (gnus-make-local-hook 'message-header-hook)
     (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
   (setq message-post-method
-       `(lambda (arg)
+       `(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))
    'exit 'postpone 'kill)
   (let ((to-be-marked (cond
-                      (yanked yanked)
+                      (yanked
+                       (mapcar
+                        (lambda (x) (if (listp x) (car x) x)) yanked))
                       (article (if (listp article) article (list article)))
                       (t nil))))
     (message-add-action
      `(when (gnus-buffer-exists-p ,buffer)
-       (save-excursion
-         (set-buffer ,buffer)
+       (with-current-buffer ,buffer
          ,(when to-be-marked
             (if (eq config 'forward)
                 `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
@@ -574,15 +577,14 @@ 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
          (gnus-setup-message 'message (message-mail)))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-group-news (&optional arg)
@@ -592,7 +594,7 @@ 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."
+network.  The corresponding back end must have a 'request-post method."
   (interactive "P")
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
@@ -605,16 +607,15 @@ network.  The corresponding backend 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
          (gnus-setup-message 'message
            (message-news (gnus-group-real-name gnus-newsgroup-name))))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-group-post-news (&optional arg)
@@ -627,8 +628,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,15 +654,14 @@ 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
          (gnus-setup-message 'message (message-mail)))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-summary-news-other-window (&optional arg)
@@ -671,7 +671,7 @@ 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."
+network.  The corresponding back end must have a 'request-post method."
   (interactive "P")
   ;; We can't `let' gnus-newsgroup-name here, since that leads