* gnus.el (gnus-other-frame-function): New user option.
[gnus] / lisp / gnus-msg.el
index 01675ce..13a2e2c 100644 (file)
@@ -66,7 +66,7 @@ current newsgroup name and then returns a suitable group name (or list
 of names)."
   :group 'gnus-message
   :type '(choice (string :tag "Group")
-                 (function)))
+                (function)))
 
 (defcustom gnus-mailing-list-groups nil
   "*Regexp matching groups that are really mailing lists.
@@ -127,6 +127,7 @@ See Info node `(gnus)Posting Styles'."
                                        (const signature-file)
                                        (const organization)
                                        (const address)
+                                       (const x-face-file)
                                        (const name)
                                        (const body)
                                        (symbol)
@@ -145,7 +146,7 @@ See Info node `(gnus)Posting Styles'."
 (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 
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
                        'gnus-gcc-mark-as-read)
 
 (defcustom gnus-gcc-externalize-attachments nil
@@ -202,13 +203,55 @@ use this option with care."
   :group 'gnus-message
   :type '(repeat (string :tag "File")))
 
-(defcustom gnus-debug-exclude-variables 
-  '(mm-mime-mule-charset-alist 
+(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 :tab "Variable")))
+  :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 replys to signed messages.
+See also the `mml-default-sign-method' variable."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+  nil
+  "Automatically encrypt replys 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 encryped 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."
+  :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.
 
@@ -285,7 +328,8 @@ 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.
 
@@ -453,6 +497,8 @@ If ARG is 1, prompt for a group name to find the posting style."
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
   (let ((group gnus-newsgroup-name)
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy)
        (buffer (current-buffer)))
     (unwind-protect
        (progn
@@ -482,6 +528,8 @@ network.  The corresponding backend must have a 'request-post method."
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
   (let ((group gnus-newsgroup-name)
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy)
        (buffer (current-buffer)))
     (unwind-protect
        (progn
@@ -513,7 +561,9 @@ a news."
                 (completing-read "Newsgroup: " gnus-active-hashtb nil
                                  (gnus-read-active-file-p))
               (gnus-group-group-name))
-          "")))
+          ""))
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy))
     (gnus-post-news 'post gnus-newsgroup-name)))
 
 (defun gnus-summary-mail-other-window (&optional arg)
@@ -525,6 +575,8 @@ posting style."
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
   (let ((group gnus-newsgroup-name)
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy)
        (buffer (current-buffer)))
     (unwind-protect
        (progn
@@ -554,6 +606,8 @@ network.  The corresponding backend must have a 'request-post method."
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
   (let ((group gnus-newsgroup-name)
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy)
        (buffer (current-buffer)))
     (unwind-protect
        (progn
@@ -585,7 +639,9 @@ a news."
                 (completing-read "Newsgroup: " gnus-active-hashtb nil
                                  (gnus-read-active-file-p))
               "")
-          gnus-newsgroup-name)))
+          gnus-newsgroup-name))
+       ;; make sure last viewed article doesn't affect posting styles:
+       (gnus-article-copy))
     (gnus-post-news 'post gnus-newsgroup-name)))
 
 
@@ -611,7 +667,8 @@ yanked."
     ;; Send a followup.
     (gnus-post-news nil gnus-newsgroup-name
                    headers gnus-article-buffer
-                   yank nil force-news)))
+                   yank nil force-news)
+    (gnus-summary-handle-replysign)))
 
 (defun gnus-summary-followup-with-original (n &optional force-news)
   "Compose a followup to an article and include the original article."
@@ -646,7 +703,10 @@ yanked."
            (message-reply-headers
             ;; The headers are decoded.
             (with-current-buffer gnus-article-copy
-              (nnheader-parse-head t))))
+              (save-restriction
+                (nnheader-narrow-to-headers)
+                (ietf-drums-unfold-fws)
+                (nnheader-parse-head t)))))
        (message-yank-original)
        (setq beg (or beg (mark t))))
       (when articles
@@ -663,7 +723,7 @@ post using the current select method."
   (let ((articles (gnus-summary-work-articles n))
        (message-post-method
         `(lambda (arg)
-           (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
+           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)
@@ -729,6 +789,7 @@ header line with the old Message-ID."
            (gnus-article-delete-text-of-type 'annotation)
            (gnus-remove-text-with-property 'gnus-prev)
            (gnus-remove-text-with-property 'gnus-next)
+           (gnus-remove-text-with-property 'gnus-decoration)
            (insert
             (prog1
                 (buffer-substring-no-properties (point-min) (point-max))
@@ -890,7 +951,7 @@ If SILENT, don't prompt the user."
          method-alist))))
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
-          (not (eq (car group-method) 'nndraft))
+          (not (memq (car group-method) gnus-discouraged-post-methods))
           (gnus-get-function group-method 'request-post t))
       (assert (not arg))
       group-method)
@@ -947,38 +1008,60 @@ If VERY-WIDE, make a very wide reply."
   (interactive
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
-  (let* ((article
-         (if (listp (car yank))
-             (caar yank)
-           (car yank)))
-        (gnus-article-reply (or article (gnus-summary-article-number)))
-        (headers ""))
-    ;; Stripping headers should be specified with mail-yank-ignored-headers.
-    (when yank
-      (gnus-summary-goto-subject article))
-    (gnus-setup-message (if yank 'reply-yank 'reply)
-      (if (not very-wide)
-         (gnus-summary-select-article)
-       (dolist (article very-wide)
-         (gnus-summary-select-article nil nil nil article)
-         (save-excursion
-           (set-buffer (gnus-copy-article-buffer))
-           (gnus-msg-treat-broken-reply-to)
-           (save-restriction
-             (message-narrow-to-head)
-             (setq headers (concat headers (buffer-string)))))))
-      (set-buffer (gnus-copy-article-buffer))
-      (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
-      (save-restriction
-       (message-narrow-to-head)
-       (when very-wide
-         (erase-buffer)
-         (insert headers))
-       (goto-char (point-max)))
-      (mml-quote-region (point) (point-max))
-      (message-reply nil wide)
+  ;; Allow user to require confirmation before replying by mail to the
+  ;; author of a news article.
+  (when (or (not (gnus-news-group-p gnus-newsgroup-name))
+           (not gnus-confirm-mail-reply-to-news)
+           (y-or-n-p "Really reply by mail to article author? "))
+    (let* ((article
+           (if (listp (car yank))
+               (caar yank)
+             (car yank)))
+          (gnus-article-reply (or article (gnus-summary-article-number)))
+          (headers ""))
+      ;; Stripping headers should be specified with mail-yank-ignored-headers.
       (when yank
-       (gnus-inews-yank-articles yank)))))
+       (gnus-summary-goto-subject article))
+      (gnus-setup-message (if yank 'reply-yank 'reply)
+       (if (not very-wide)
+           (gnus-summary-select-article)
+         (dolist (article very-wide)
+           (gnus-summary-select-article nil nil nil article)
+           (save-excursion
+             (set-buffer (gnus-copy-article-buffer))
+             (gnus-msg-treat-broken-reply-to)
+             (save-restriction
+               (message-narrow-to-head)
+               (setq headers (concat headers (buffer-string)))))))
+       (set-buffer (gnus-copy-article-buffer))
+       (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
+       (save-restriction
+         (message-narrow-to-head)
+         (when very-wide
+           (erase-buffer)
+           (insert headers))
+         (goto-char (point-max)))
+       (mml-quote-region (point) (point-max))
+       (message-reply nil wide)
+       (when yank
+         (gnus-inews-yank-articles yank))
+       (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+  "Check the various replysign variables and take action accordingly."
+  (when (or gnus-message-replysign gnus-message-replyencrypt)
+    (let (signed encrypted)
+      (save-excursion
+       (set-buffer gnus-article-buffer)
+       (setq signed (memq 'signed gnus-article-wash-types))
+       (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+      (cond ((and gnus-message-replysign signed)
+            (mml-secure-message mml-default-sign-method 'sign))
+           ((and gnus-message-replyencrypt encrypted)
+            (mml-secure-message mml-default-encrypt-method
+                                (if gnus-message-replysignencrypted
+                                    'signencrypt
+                                  'encrypt)))))))
 
 (defun gnus-summary-reply-with-original (n &optional wide)
   "Start composing a reply mail to the current message.
@@ -1050,38 +1133,43 @@ For the `inline' alternatives, also see the variable
   (interactive "P")
   (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)))))
+           (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
+                  (or (and (gnus-buffer-live-p gnus-article-buffer)
+                           (with-current-buffer gnus-article-buffer
+                             gnus-article-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."
   (interactive
-   (list (message-read-from-minibuffer 
+   (list (message-read-from-minibuffer
          "Resend message(s) to: "
-         (when (gnus-buffer-live-p gnus-original-article-buffer)
+         (when (and gnus-summary-resend-default-address
+                    (gnus-buffer-live-p gnus-original-article-buffer))
            ;; If some other article is currently selected, the
            ;; initial-contents is wrong. Whatever, it is just the
            ;; initial-contents.
@@ -1097,6 +1185,35 @@ For the `inline' alternatives, also see the variable
        (message-resend address))
       (gnus-summary-mark-article-as-forwarded article))))
 
+;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
+(defun gnus-summary-resend-message-edit ()
+  "Resend an article that has already been sent.
+A new buffer will be created to allow the user to modify body and
+contents of the message, and then, everything will happen as when
+composing a new message."
+  (interactive)
+  (let ((article (gnus-summary-article-number)))
+    (gnus-setup-message 'reply-yank
+      (gnus-summary-select-article t)
+      (set-buffer gnus-original-article-buffer)
+      (let ((cur (current-buffer))
+           (to (message-fetch-field "to")))
+       ;; Get a normal message buffer.
+       (message-pop-to-buffer (message-buffer-name "Resend" to))
+       (insert-buffer-substring cur)
+       (mime-to-mml)
+       (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.
+       (goto-char (point-max))
+       (insert mail-header-separator)
+       (goto-char (point-min))
+       (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+       (forward-char 1)
+       (widen)))))
+
 (defun gnus-summary-post-forward (&optional arg)
   "Forward the current article to a newsgroup.
 See `gnus-summary-mail-forward' for ARG."
@@ -1235,7 +1352,7 @@ If YANK is non-nil, include the original article."
          (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
          (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
     (when address
-      (message-reply address)
+      (gnus-msg-mail address)
       (when yank
        (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
 
@@ -1460,7 +1577,7 @@ this is a reply."
                (gnus-message 1 "Couldn't store article in group %s: %s"
                              group (gnus-status-message method))
                (sit-for 2))
-             (when (and group-art 
+             (when (and group-art
                         (or gnus-gcc-mark-as-read
                             gnus-inews-mark-gcc-as-read))
                (gnus-group-mark-article-read group (cdr group-art)))
@@ -1638,13 +1755,20 @@ this is a reply."
                   ((listp value)
                    (eval value))))
            ;; Translate obsolescent value.
-           (when (eq element 'signature-file)
+           (cond
+            ((eq element 'signature-file)
              (setq element 'signature
                    filep t))
+            ((eq element 'x-face-file)
+             (setq element 'x-face
+                   filep t)))
            ;; Get the contents of file elems.
            (when (and filep v)
              (setq v (with-temp-buffer
                        (insert-file-contents v)
+                       (goto-char (point-max))
+                       (while (bolp)
+                         (delete-char -1))
                        (buffer-string))))
            (setq results (delq (assoc element results) results))
            (push (cons element v) results))))