(dns-get-txt-answer): New function.
[gnus] / lisp / gnus-msg.el
index 811c8ea..7c2c881 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 (require 'gnus-ems)
 (require 'message)
 (require 'gnus-art)
+(require 'gnus-util)
 
 (defcustom gnus-post-method 'current
   "*Preferred method for posting USENET news.
 
-If this variable is `current', Gnus will use the \"current\" select
-method when posting.  If it is nil (which is the default), Gnus will
-use the native select method when posting.
+If this variable is `current' (which is the default), Gnus will use
+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)
-                 (const current)
-                (const native)
+  :link '(custom-manual "(gnus)Posting Server")
+  :type `(choice (const native)
+                (const current)
                 (sexp :tag "Methods" ,gnus-select-method)))
 
-(defvar gnus-outgoing-message-group nil
+(defcustom gnus-outgoing-message-group nil
   "*All outgoing messages will be put in this group.
 If you want to store all your outgoing mail and articles in the group
 \"nnml:archive\", you set this variable to that value.  This variable
@@ -63,18 +64,26 @@ can also be a list of group names.
 If you want to have greater control over what group to put each
 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).")
+of names)."
+  :group 'gnus-message
+  :type '(choice (string :tag "Group")
+                (function)))
 
-(defvar gnus-mailing-list-groups nil
-  "*Regexp matching groups that are really mailing lists.
+(defcustom gnus-mailing-list-groups nil
+  "*If non-nil a regexp matching groups that are really mailing lists.
 This is useful when you're reading a mailing list that has been
 gatewayed to a newsgroup, and you want to followup to an article in
-the group.")
+the group."
+  :group 'gnus-message
+  :type '(choice (regexp)
+                (const nil)))
 
-(defvar gnus-add-to-list nil
-  "*If non-nil, add a `to-list' parameter automatically.")
+(defcustom gnus-add-to-list nil
+  "*If non-nil, add a `to-list' parameter automatically."
+  :group 'gnus-message
+  :type 'boolean)
 
-(defvar gnus-crosspost-complaint
+(defcustom gnus-crosspost-complaint
   "Hi,
 
 You posted the article below with the following Newsgroups header:
@@ -90,25 +99,79 @@ Thank you.
 "
   "Format string to be inserted when complaining about crossposts.
 The first %s will be replaced by the Newsgroups header;
-the second with the current group name.")
-
-(defvar gnus-message-setup-hook nil
-  "Hook run after setting up a message buffer.")
-
-(defvar gnus-bug-create-help-buffer t
-  "*Should we create the *Gnus Help Bug* buffer?")
-
-(defvar gnus-posting-styles nil
-  "*Alist of styles to use when posting.")
-
-(defvar gnus-inews-mark-gcc-as-read nil
-  "If non-nil, automatically mark Gcc articles as read.")
-
-(defcustom gnus-group-posting-charset-alist
+the second with the current group name."
+  :group 'gnus-message
+  :type 'string)
+
+(defcustom gnus-message-setup-hook nil
+  "Hook run after setting up a message buffer."
+  :group 'gnus-message
+  :type 'hook)
+
+(defcustom gnus-bug-create-help-buffer t
+  "*Should we create the *Gnus Help Bug* buffer?"
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-posting-styles nil
+  "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."
+  :group 'gnus-message
+  :link '(custom-manual "(gnus)Posting Styles")
+  :type '(repeat (cons (choice (regexp)
+                              (variable)
+                              (list (const header)
+                                    (string :tag "Header")
+                                    (regexp :tag "Regexp"))
+                              (function)
+                              (sexp))
+                      (repeat (list
+                               (choice (const signature)
+                                       (const signature-file)
+                                       (const organization)
+                                       (const address)
+                                       (const x-face-file)
+                                       (const name)
+                                       (const body)
+                                       (symbol)
+                                       (string :tag "Header"))
+                               (choice (string)
+                                       (function)
+                                       (variable)
+                                       (sexp)))))))
+
+(defcustom gnus-gcc-mark-as-read nil
+  "If non-nil, automatically mark Gcc articles as read."
+  :version "21.1"
+  :group 'gnus-message
+  :type 'boolean)
+
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
+                       'gnus-gcc-mark-as-read)
+
+(defcustom gnus-gcc-externalize-attachments nil
+  "Should local-file attachments be included as external parts in Gcc copies?
+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"
+  :group 'gnus-message
+  :type '(choice (const nil :tag "None")
+                (const all :tag "Any")
+                (string :tag "Regexp")))
+
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
   '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
     ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
     (message-this-is-mail nil nil)
     (message-this-is-news nil t))
+ :variable-document
   "Alist of regexps and permitted unencoded charsets for posting.
 Each element of the alist has the form (TEST HEADER BODY-LIST), where
 TEST is either a regular expression matching the newsgroup header or a
@@ -121,32 +184,118 @@ nil (always encode using quoted-printable) or t (always use 8bit).
 
 Note that any value other than nil for HEADER infringes some RFCs, so
 use this option with care."
-  :type '(repeat (list :tag "Permitted unencoded charsets"
-                 (choice :tag "Where"
-                  (regexp :tag "Group")
-                  (const :tag "Mail message" :value message-this-is-mail)
-                  (const :tag "News article" :value message-this-is-news))
-                 (choice :tag "Header"
-                  (const :tag "None" nil)
-                  (symbol :tag "Charset"))
-                 (choice :tag "Body"
-                         (const :tag "Any" :value t)
-                         (const :tag "None" :value nil)
-                         (repeat :tag "Charsets"
-                                 (symbol :tag "Charset")))))
-  :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+               (choice :tag "Where"
+                       (regexp :tag "Group")
+                       (const :tag "Mail message" :value message-this-is-mail)
+                       (const :tag "News article" :value message-this-is-news))
+               (choice :tag "Header"
+                       (const :tag "None" nil)
+                       (symbol :tag "Charset"))
+               (choice :tag "Body"
+                       (const :tag "Any" :value t)
+                       (const :tag "None" :value nil)
+                       (repeat :tag "Charsets"
+                               (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+                         :value nil
+                         (repeat (symbol)))
+ :parameter-document       "\
+List of charsets that are permitted to be unencoded.")
+
+(defcustom gnus-debug-files
+  '("gnus.el" "gnus-sum.el" "gnus-group.el"
+    "gnus-art.el" "gnus-start.el" "gnus-async.el"
+    "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+    "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"
+  :group 'gnus-message
+  :type '(repeat (string :tag "File")))
+
+(defcustom gnus-debug-exclude-variables
+  '(mm-mime-mule-charset-alist
+    nnmail-split-fancy message-minibuffer-local-map)
+  "Variables that should not be reported in `gnus-bug'."
+  :version "21.1"
+  :group 'gnus-message
+  :type '(repeat (symbol :tag "Variable")))
+
+(defcustom gnus-discouraged-post-methods
+  '(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"
+  :group 'gnus-group-foreign
+  :type '(repeat (symbol :tag "Back end")))
+
+(defcustom gnus-message-replysign
+  nil
+  "Automatically sign replies to signed messages.
+See also the `mml-default-sign-method' variable."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+  nil
+  "Automatically encrypt replies to encrypted messages.
+See also the `mml-default-encrypt-method' variable."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-message-replysignencrypted
+  t
+  "Setting this causes automatically encrypted messages to also be signed."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-confirm-mail-reply-to-news nil
+  "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
+matches the regexp."
+  :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")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+  nil
+  "If non-nil, Gnus will treat mail like news with regard to confirmation
+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."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+  "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'."
+  :group 'gnus-message
+  :type 'boolean)
 
 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
   "Inhibit the use of posting styles.")
 
+(defvar gnus-article-yanked-articles nil)
 (defvar gnus-message-buffer "*Mail Gnus*")
 (defvar gnus-article-copy nil)
 (defvar gnus-check-before-posting nil)
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
+(defvar gnus-msg-force-broken-reply-to nil)
+
 (defconst gnus-bug-message
   "Sending a bug report to the Gnus Towers.
 ========================================
@@ -169,11 +318,7 @@ 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
 ;;;
@@ -182,6 +327,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
@@ -191,11 +337,15 @@ Thank you for your help in stamping out bugs.
   "R" gnus-summary-reply-with-original
   "w" gnus-summary-wide-reply
   "W" gnus-summary-wide-reply-with-original
+  "v" gnus-summary-very-wide-reply
+  "V" gnus-summary-very-wide-reply-with-original
   "n" gnus-summary-followup-to-mail
   "N" gnus-summary-followup-to-mail-with-original
   "m" gnus-summary-mail-other-window
   "u" gnus-uu-post-news
   "\M-c" gnus-summary-mail-crosspost-complaint
+  "Br" gnus-summary-reply-broken-reply-to
+  "BR" gnus-summary-reply-broken-reply-to-with-original
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
   "Om" gnus-uu-digest-mail-forward
@@ -204,19 +354,27 @@ Thank you for your help in stamping out bugs.
 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
   "b" gnus-summary-resend-bounced-mail
   ;; "c" gnus-summary-send-draft
-  "r" gnus-summary-resend-message)
+  "r" gnus-summary-resend-message
+  "e" gnus-summary-resend-message-edit)
 
 ;;; Internal functions.
 
+(defun gnus-inews-make-draft (articles)
+  `(lambda ()
+     (gnus-inews-make-draft-meta-information
+      ,gnus-newsgroup-name ',articles)))
+
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
        (buffer (make-symbol "gnus-setup-message-buffer"))
        (article (make-symbol "gnus-setup-message-article"))
+       (yanked (make-symbol "gnus-setup-yanked-articles"))
        (group (make-symbol "gnus-setup-message-group")))
     `(let ((,winconf (current-window-configuration))
           (,buffer (buffer-name (current-buffer)))
-          (,article (and gnus-article-reply (gnus-summary-article-number)))
+          (,article gnus-article-reply)
+          (,yanked gnus-article-yanked-articles)
           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
@@ -225,12 +383,34 @@ 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
+                (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 ,yanked))
+              message-required-headers))
        (unwind-protect
           (progn
             ,@forms)
-        (gnus-inews-add-send-actions ,winconf ,buffer ,article)
-        (gnus-inews-insert-draft-meta-information ,group ,article)
+        (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+                                     ,yanked)
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
@@ -240,33 +420,74 @@ Thank you for your help in stamping out bugs.
             (let ((mbl1 mml-buffer-list))
               (setq mml-buffer-list mbl)  ;; Global value
               (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+              (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)
           (setq mml-buffer-list mbl)))
+       (message-hide-headers)
        (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)
-  (save-excursion
-    (when (and group
-              (not (string= group ""))
-              (not (message-fetch-field gnus-draft-meta-information-header)))
-      (goto-char (point-min))
-      (insert gnus-draft-meta-information-header ": (\"" group "\" "
-             (if article (number-to-string article) "\"\"") ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group articles)
+  (when (numberp articles)
+    (setq articles (list articles)))
+  (concat "(\"" group "\" "
+         (if articles
+             (mapconcat
+              (lambda (elem)
+                (number-to-string
+                 (if (consp elem)
+                     (car elem)
+                   elem)))
+              articles " ")
+           "")
+         ")"))
 
 ;;;###autoload
-(defun gnus-msg-mail (&rest args)
+(defun gnus-msg-mail (&optional to subject other-headers continue
+                               switch-action yank-action send-actions)
   "Start editing a mail message to be sent.
 Like `message-mail', but with Gnus paraphernalia, particularly the
 Gcc: header for archiving purposes."
   (interactive)
-  (gnus-setup-message 'message
-    (apply 'message-mail args))
+  (let ((buf (current-buffer))
+       mail-buf)
+    (gnus-setup-message 'message
+      (message-mail to subject other-headers continue
+                   nil yank-action send-actions))
+    (when switch-action
+      (setq mail-buf (current-buffer))
+      (switch-to-buffer buf)
+      (apply switch-action mail-buf nil)))
   ;; 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))))
+
+;;;###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))))
+
 ;;;###autoload
 (define-mail-user-agent 'gnus-user-agent