Merge branch 'master' of https://git.gnus.org/gnus
[gnus] / lisp / gnus-msg.el
index 5e163e4..fce9a36 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
 
-;; Copyright (C) 1995-201 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -174,7 +174,7 @@ 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"
+  :version "24.3"
   :group 'gnus-message
   :type '(choice (const none) (const t) string (const nil)
                 (const no-gcc-self)))
@@ -313,6 +313,24 @@ 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
+  :version "24.3"
+  :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
+  :version "24.3"
+  :type 'hook)
+
 (autoload 'gnus-message-citation-mode "gnus-cite" nil t)
 
 ;;; Internal variables.
@@ -397,6 +415,11 @@ Thank you for your help in stamping out bugs.
      (gnus-inews-make-draft-meta-information
       ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
 
+(autoload 'nnir-article-number "nnir" nil nil 'macro)
+(autoload 'nnir-article-group "nnir" nil nil 'macro)
+(autoload 'gnus-nnir-group-p "nnir")
+
+
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
@@ -408,15 +431,22 @@ Thank you for your help in stamping out bugs.
     `(let ((,winconf (current-window-configuration))
           (,winconf-name gnus-current-window-configuration)
           (,buffer (buffer-name (current-buffer)))
-          (,article gnus-article-reply)
+          (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+                             gnus-article-reply)
+                        (nnir-article-number gnus-article-reply)
+                      gnus-article-reply))
           (,yanked gnus-article-yanked-articles)
-          (,group gnus-newsgroup-name)
+          (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+                           gnus-article-reply)
+                      (nnir-article-group gnus-article-reply)
+                    gnus-newsgroup-name))
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
           (mbl mml-buffer-list)
           (message-mode-hook (copy-sequence message-mode-hook)))
        (setq mml-buffer-list nil)
-       (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
+       (add-hook 'message-header-setup-hook (lambda ()
+                                                     (gnus-inews-insert-gcc ,group)))
        ;; 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
@@ -503,9 +533,13 @@ If Gnus isn't running, a plain `message-mail' setup is used
 instead."
   (interactive)
   (if (not (gnus-alive-p))
-      (message-mail to subject other-headers continue
-                    nil yank-action send-actions return-action)
+      (progn
+       (message "Gnus not running; using plain Message mode")
+       (message-mail to subject other-headers continue
+                     nil yank-action send-actions return-action))
     (let ((buf (current-buffer))
+         ;; Don't use posting styles corresponding to any existing group.
+         (gnus-newsgroup-name "")
          mail-buf)
       (gnus-setup-message 'message
        (message-mail to subject other-headers continue
@@ -825,9 +859,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)
@@ -1297,26 +1343,27 @@ For the \"inline\" alternatives, also see the variable
                                          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 gnus-gcc-self-resent-messages 'none))
-           ((eq gnus-gcc-self-resent-messages t)
+      (cond ((eq self 'none))
+           ((eq self t)
             (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
-           ((stringp gnus-gcc-self-resent-messages)
+           ((stringp self)
             (insert "Gcc: "
                     (mm-encode-coding-string
-                     (if (string-match " " gnus-gcc-self-resent-messages)
-                         (concat "\"" gnus-gcc-self-resent-messages "\"")
-                       gnus-gcc-self-resent-messages)
-                     (gnus-group-name-charset
-                      (gnus-inews-group-method gnus-gcc-self-resent-messages)
-                      gnus-gcc-self-resent-messages))
+                     (if (string-match " " self)
+                         (concat "\"" self "\"")
+                       self)
+                     (gnus-group-name-charset (gnus-inews-group-method self)
+                                              self))
                     "\n"))
-           ((null gnus-gcc-self-resent-messages)
+           ((null self)
             (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
-           ((eq gnus-gcc-self-resent-messages 'no-gcc-self)
+           ((eq self 'no-gcc-self)
             (when (setq gcc (delete
                              gnus-newsgroup-name
                              (delete (concat "\"" gnus-newsgroup-name "\"")
@@ -1337,13 +1384,34 @@ For the \"inline\" alternatives, also see the variable
              (nnmail-fetch-field "to"))))
         current-prefix-arg))
   (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
-       (message-sent-hook (copy-sequence message-sent-hook)))
+       (message-sent-hook (copy-sequence message-sent-hook))
+       ;; Honor posting-style for `name' and `address' in Resent-From header.
+       (styles (gnus-group-find-parameter gnus-newsgroup-name
+                                          'posting-style t))
+       (user-full-name user-full-name)
+       (user-mail-address user-mail-address)
+       tem)
+    (dolist (style styles)
+      (when (stringp (cadr style))
+       (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+    (dolist (style (if styles
+                      (append gnus-posting-styles (list (cons ".*" styles)))
+                    gnus-posting-styles))
+      (when (and (stringp (car style))
+                (string-match (pop style) gnus-newsgroup-name))
+       (when (setq tem (cadr (assq 'name style)))
+         (setq user-full-name tem))
+       (when (setq tem (cadr (assq 'address style)))
+         (setq user-mail-address tem))))
     ;; `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 (if gnus-agent
-                                    'gnus-agent-possibly-do-gcc
-                                  'gnus-inews-do-gcc))
+    (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
@@ -1422,33 +1490,6 @@ See `gnus-summary-mail-forward' for ARG."
        (when (gnus-y-or-n-p "Send this complaint? ")
          (message-send-and-exit))))))
 
-(defun gnus-mail-parse-comma-list ()
-  (let (accumulated
-       beg)
-    (skip-chars-forward " ")
-    (while (not (eobp))
-      (setq beg (point))
-      (skip-chars-forward "^,")
-      (while (zerop
-             (save-excursion
-               (save-restriction
-                 (let ((i 0))
-                   (narrow-to-region beg (point))
-                   (goto-char beg)
-                   (logand (progn
-                             (while (search-forward "\"" nil t)
-                               (incf i))
-                             (if (zerop i) 2 i))
-                           2)))))
-       (skip-chars-forward ",")
-       (skip-chars-forward "^,"))
-      (skip-chars-backward " ")
-      (push (buffer-substring beg (point))
-           accumulated)
-      (skip-chars-forward "^,")
-      (skip-chars-forward ", "))
-    accumulated))
-
 (defun gnus-inews-add-to-address (group)
   (let ((to-address (mail-fetch-field "to")))
     (when (and to-address
@@ -1459,41 +1500,6 @@ See `gnus-summary-mail-forward' for ARG."
             (format "Do you want to add this as `to-list': %s? " to-address))
        (gnus-group-add-parameter group (cons 'to-list to-address))))))
 
-(defun gnus-put-message ()
-  "Put the current message in some group and return to Gnus."
-  (interactive)
-  (let ((reply gnus-article-reply)
-       (winconf gnus-prev-winconf)
-       (group gnus-newsgroup-name))
-    (unless (and&nb