Merge remote branch 'origin/no-gnus'
[gnus] / lisp / gnus-msg.el
index 507f040..8d16a42 100644 (file)
@@ -163,6 +163,22 @@ if nil, attach files as normal parts."
                 (const all :tag "Any")
                 (string :tag "Regexp")))
 
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+  "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'.  Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made.  If this is t, messages
+resent will be Gcc'd to the current group.  If this is a string, it
+specifies a group to which resent messages will be Gcc'd.  If this is
+nil, Gcc will be done according to existing Gcc header(s), if any.
+If this is `no-gcc-self', resent messages will be Gcc'd to groups that
+existing Gcc header specifies, except for the current group."
+  :version "24.2"
+  :group 'gnus-message
+  :type '(choice (const none) (const t) string (const nil)
+                (const no-gcc-self)))
+
 (gnus-define-group-parameter
  posting-charset-alist
  :type list
@@ -297,6 +313,22 @@ If nil, the address field will always be empty after invoking
   :group 'gnus-message
   :type 'boolean)
 
+(defcustom gnus-gcc-pre-body-encode-hook nil
+  "A hook called before encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header.  Changes made to the message will
+only affect the Gcc copy, but not the original message."
+  :group 'gnus-message
+  :type 'hook)
+
+(defcustom gnus-gcc-post-body-encode-hook nil
+    "A hook called after encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header.  Changes made to the message will
+only affect the Gcc copy, but not the original message."
+  :group 'gnus-message
+  :type 'hook)
+
 (autoload 'gnus-message-citation-mode "gnus-cite" nil t)
 
 ;;; Internal variables.
@@ -809,9 +841,21 @@ post using the current select method."
   (interactive (gnus-interactive "P\ny"))
   (let ((message-post-method
         `(lambda (arg)
-           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
+       (user-mail-address user-mail-address))
     (dolist (article (gnus-summary-work-articles n))
       (when (gnus-summary-select-article t nil nil article)
+       ;; Pretend that we're doing a followup so that we can see what
+       ;; the From header would have ended up being.
+       (save-window-excursion
+         (save-excursion
+           (gnus-summary-followup nil)
+           (let ((from (message-fetch-field "from")))
+             (when from
+               (setq user-mail-address
+                     (car (mail-header-parse-address from)))))
+           (kill-buffer (current-buffer))))
+       ;; Now cancel the article using the From header we got.
        (when (gnus-eval-in-buffer-window gnus-original-article-buffer
                (message-cancel-news))
          (gnus-summary-mark-as-read article gnus-canceled-mark)
@@ -1270,6 +1314,44 @@ For the \"inline\" alternatives, also see the variable
            (set-buffer gnus-original-article-buffer)
            (message-forward post)))))))
 
+(defun gnus-summary-resend-message-insert-gcc ()
+  "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+  (gnus-inews-insert-gcc)
+  (let ((gcc (mapcar
+             (lambda (group)
+               (mm-encode-coding-string
+                group
+                (gnus-group-name-charset (gnus-inews-group-method group)
+                                         group)))
+             (message-unquote-tokens
+              (message-tokenize-header (mail-fetch-field "gcc" nil t)
+                                       " ,"))))
+       (self (with-current-buffer gnus-summary-buffer
+               gnus-gcc-self-resent-messages)))
+    (message-remove-header "gcc")
+    (when gcc
+      (goto-char (point-max))
+      (cond ((eq self 'none))
+           ((eq self t)
+            (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+           ((stringp self)
+            (insert "Gcc: "
+                    (mm-encode-coding-string
+                     (if (string-match " " self)
+                         (concat "\"" self "\"")
+                       self)
+                     (gnus-group-name-charset (gnus-inews-group-method self)
+                                              self))
+                    "\n"))
+           ((null self)
+            (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+           ((eq self 'no-gcc-self)
+            (when (setq gcc (delete
+                             gnus-newsgroup-name
+                             (delete (concat "\"" gnus-newsgroup-name "\"")
+                                     gcc)))
+              (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive
@@ -1283,12 +1365,24 @@ For the \"inline\" alternatives, also see the variable
            (with-current-buffer gnus-original-article-buffer
              (nnmail-fetch-field "to"))))
         current-prefix-arg))
-  (dolist (article (gnus-summary-work-articles n))
-    (gnus-summary-select-article nil nil nil article)
-    (with-current-buffer gnus-original-article-buffer
-      (let ((gnus-gcc-externalize-attachments nil))
-       (message-resend address)))
-    (gnus-summary-mark-article-as-forwarded article)))
+  (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+       (message-sent-hook (copy-sequence message-sent-hook)))
+    ;; `gnus-summary-resend-message-insert-gcc' must run last.
+    (add-hook 'message-header-setup-hook
+             'gnus-summary-resend-message-insert-gcc t)
+    (add-hook 'message-sent-hook
+             `(lambda ()
+                (let ((rfc2047-encode-encoded-words nil))
+                  ,(if gnus-agent
+                       '(gnus-agent-possibly-do-gcc)
+                     '(gnus-inews-do-gcc)))))
+    (dolist (article (gnus-summary-work-articles n))
+      (gnus-summary-select-article nil nil nil article)
+      (with-current-buffer gnus-original-article-buffer
+       (let ((gnus-gcc-externalize-attachments nil)
+             (message-inhibit-body-encoding t))
+         (message-resend address)))
+      (gnus-summary-mark-article-as-forwarded article))))
 
 ;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
 (defun gnus-summary-resend-message-edit ()
@@ -1580,7 +1674,9 @@ this is a reply."
              (nnheader-set-temp-buffer " *acc*")
              (setq message-options (with-current-buffer cur message-options))
              (insert-buffer-substring cur)
+             (run-hooks 'gnus-gcc-pre-body-encode-hook)
              (message-encode-message-body)
+             (run-hooks 'gnus-gcc-post-body-encode-hook)
              (save-restriction
                (message-narrow-to-headers)
                (let* ((mail-parse-charset message-default-charset)
@@ -1629,12 +1725,16 @@ this is a reply."
              (when (and group-art
                         ;; FIXME: Should gcc-mark-as-read work when
                         ;; Gnus is not running?
-                        (gnus-alive-p)
-                        (or gnus-gcc-mark-as-read
-                            (and
-                             (boundp 'gnus-inews-mark-gcc-as-read)
-                             (symbol-value 'gnus-inews-mark-gcc-as-read))))
-               (gnus-group-mark-article-read group (cdr group-art)))
+                        (gnus-alive-p))
+               (if (or gnus-gcc-mark-as-read
+                       (and (boundp 'gnus-inews-mark-gcc-as-read)
+                            (symbol-value 'gnus-inews-mark-gcc-as-read)))
+                   (gnus-group-mark-article-read group (cdr group-art))
+                 (with-current-buffer gnus-group-buffer
+                   (let ((gnus-group-marked (list group))
+                         (gnus-get-new-news-hook nil)
+                         (inhibit-read-only t))
+                     (gnus-group-get-new-news-this-group nil t)))))
              (setq options message-options)
              (with-current-buffer cur (setq message-options options))
              (kill-buffer (current-buffer)))))))))