Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-msg.el
index c2604bd..cb5581f 100644 (file)
@@ -55,11 +55,11 @@ 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 current)
                 (const native)
                 (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
@@ -68,18 +68,25 @@ 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
+(defcustom gnus-mailing-list-groups nil
   "*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 'regexp)
 
-(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:
@@ -95,19 +102,44 @@ 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 '(gnus-maybe-setup-default-charset)
-  "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.")
+the second with the current group name."
+  :group 'gnus-message
+  :type 'string)
+
+(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
+  "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."
+  :group 'gnus-message
+  :type '(repeat (cons (choice (regexp)
+                              (function)
+                              (variable)
+                              (sexp))
+                      (repeat (list
+                               (choice (const signature)
+                                       (const signature-file)
+                                       (const organization)
+                                       (const address)
+                                       (const name)
+                                       (const body)
+                                       (string :tag "Header"))
+                               (choice (string)
+                                       (function)
+                                       (variable)
+                                       (sexp)))))))
+
+(defcustom gnus-inews-mark-gcc-as-read nil
+  "If non-nil, automatically mark Gcc articles as read."
+  :group 'gnus-message
+  :type 'boolean)
 
 (defcustom gnus-group-posting-charset-alist
   '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
@@ -127,18 +159,20 @@ 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")))))
+                      (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)
 
 ;;; Internal variables.
@@ -152,6 +186,8 @@ use this option with care."
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
+(defvar gnus-msg-force-broken-reply-to nil)
+
 (defconst gnus-bug-message
   (format "Sending a bug report to the Gnus Towers.
 ========================================
@@ -213,6 +249,8 @@ Thank you for your help in stamping out bugs.
   "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-summary-digest-mail-forward
@@ -578,7 +616,7 @@ header line with the old Message-ID."
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))
            (setq beg (point))
-           (setq end (or (message-goto-body) point))
+           (setq end (or (message-goto-body) beg))
            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)
            (delete-region (goto-char (point-min))
@@ -651,10 +689,11 @@ header line with the old Message-ID."
        (when yank
          (gnus-inews-yank-articles yank))))))
 
-(defun gnus-msg-treat-broken-reply-to ()
+(defun gnus-msg-treat-broken-reply-to (&optional force)
   "Remove the Reply-to header iff broken-reply-to."
-  (when (gnus-group-find-parameter
-        gnus-newsgroup-name 'broken-reply-to)
+  (when (or force
+           (gnus-group-find-parameter
+            gnus-newsgroup-name 'broken-reply-to))
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header "reply-to"))))
@@ -808,7 +847,7 @@ If VERY-WIDE, make a very wide reply."
              (message-narrow-to-head)
              (setq headers (concat headers (buffer-string)))))))
       (set-buffer (gnus-copy-article-buffer))
-      (gnus-msg-treat-broken-reply-to)
+      (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
       (save-restriction
        (message-narrow-to-head)
        (when very-wide
@@ -825,6 +864,24 @@ The original article will be yanked."
   (interactive "P")
   (gnus-summary-reply (gnus-summary-work-articles n) wide))
 
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+  "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+  (interactive
+   (list (and current-prefix-arg
+             (gnus-summary-work-articles 1))))
+  (let ((gnus-msg-force-broken-reply-to t))
+    (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+  "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+  (interactive "P")
+  (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
 (defun gnus-summary-wide-reply (&optional yank)
   "Start composing a wide reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
@@ -1277,42 +1334,41 @@ this is a reply."
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
   (interactive)
-  (when (gnus-alive-p)
-    (save-excursion
-      (save-restriction
-       (message-narrow-to-headers)
-       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
-             (coding-system-for-write 'raw-text)
-             (output-coding-system 'raw-text)
-             groups group method group-art)
-         (when gcc
-           (message-remove-header "gcc")
-           (widen)
-           (setq groups (message-unquote-tokens
-                          (message-tokenize-header gcc " ,")))
-           ;; Copy the article over to some group(s).
-           (while (setq group (pop groups))
-             (gnus-check-server
-              (setq method (gnus-inews-group-method group)))
-             (unless (gnus-request-group group nil method)
-               (gnus-request-create-group group method))
-             (save-excursion
-               (nnheader-set-temp-buffer " *acc*")
-               (insert-buffer-substring message-encoding-buffer)
-               (gnus-run-hooks 'gnus-before-do-gcc-hook)
-               (goto-char (point-min))
-               (when (re-search-forward
-                      (concat "^" (regexp-quote mail-header-separator) "$")
-                      nil t)
-                 (replace-match "" t t ))
-               (unless (setq group-art
-                             (gnus-request-accept-article group method t t))
-                 (gnus-message 1 "Couldn't store article in group %s: %s"
-                               group (gnus-status-message method))
-                 (sit-for 2))
-               (when (and group-art gnus-inews-mark-gcc-as-read)
-                 (gnus-group-mark-article-read group (cdr group-art)))
-               (kill-buffer (current-buffer))))))))))
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+           (coding-system-for-write 'raw-text)
+           (output-coding-system 'raw-text)
+           groups group method group-art)
+       (when gcc
+         (message-remove-header "gcc")
+         (widen)
+         (setq groups (message-unquote-tokens
+                       (message-tokenize-header gcc " ,")))
+         ;; Copy the article over to some group(s).
+         (while (setq group (pop groups))
+           (gnus-check-server
+            (setq method (gnus-inews-group-method group)))
+           (unless (gnus-request-group group nil method)
+             (gnus-request-create-group group method))
+           (save-excursion
+             (nnheader-set-temp-buffer " *acc*")
+             (insert-buffer-substring message-encoding-buffer)
+             (gnus-run-hooks 'gnus-before-do-gcc-hook)
+             (goto-char (point-min))
+             (when (re-search-forward
+                    (concat "^" (regexp-quote mail-header-separator) "$")
+                    nil t)
+               (replace-match "" t t ))
+             (unless (setq group-art
+                           (gnus-request-accept-article group method t t))
+               (gnus-message 1 "Couldn't store article in group %s: %s"
+                             group (gnus-status-message method))
+               (sit-for 2))
+             (when (and group-art gnus-inews-mark-gcc-as-read)
+               (gnus-group-mark-article-read group (cdr group-art)))
+             (kill-buffer (current-buffer)))))))))
 
 (defun gnus-inews-insert-gcc ()
   "Insert Gcc headers based on `gnus-outgoing-message-group'."
@@ -1526,8 +1582,8 @@ this is a reply."
       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()
-                    (set (make-local-variable 'user-mail-address)
-                         ,(or (cdr address) user-mail-address))
+                    (set (make-local-variable 'user-mail-address)
+                         ,(or (cdr address) user-mail-address))
                     (let ((user-full-name ,(or (cdr name) (user-full-name)))
                           (user-mail-address
                            ,(or (cdr address) user-mail-address)))
@@ -1543,7 +1599,7 @@ this is a reply."
 (defun gnus-maybe-setup-default-charset ()
   (let ((charset
         (and (boundp 'gnus-summary-buffer)
-              (buffer-live-p gnus-summary-buffer)
+             (buffer-live-p gnus-summary-buffer)
              (save-excursion
                (set-buffer gnus-summary-buffer)
                default-mime-charset))))