Add missing :version tags

[gnus] / lisp / gnus-msg.el

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 58561d8..77bb628 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -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."
 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)))
   :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)
 
   :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.
 (autoload 'gnus-message-citation-mode "gnus-cite" nil t)
 
 ;;; Internal variables.


@@ -494,7 +512,8 @@ Thank you for your help in stamping out bugs.
 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue
 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue

-                               switch-action yank-action send-actions return-action)
+                               switch-action yank-action send-actions
+                               return-action)

   "Start editing a mail message to be sent.
 Like `message-mail', but with Gnus paraphernalia, particularly the
 Gcc: header for archiving purposes.
   "Start editing a mail message to be sent.
 Like `message-mail', but with Gnus paraphernalia, particularly the
 Gcc: header for archiving purposes.


@@ -502,8 +521,12 @@ If Gnus isn't running, a plain `message-mail' setup is used
 instead."
   (interactive)
   (if (not (gnus-alive-p))
 instead."
   (interactive)
   (if (not (gnus-alive-p))

-      (message-mail)
+      (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))
     (let ((buf (current-buffer))

+         (gnus-newsgroup-name (or gnus-newsgroup-name ""))

          mail-buf)
       (gnus-setup-message 'message
        (message-mail to subject other-headers continue
          mail-buf)
       (gnus-setup-message 'message
        (message-mail to subject other-headers continue


@@ -823,9 +846,21 @@ post using the current select method."
   (interactive (gnus-interactive "P\ny"))
   (let ((message-post-method
         `(lambda (arg)
   (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)
     (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)
        (when (gnus-eval-in-buffer-window gnus-original-article-buffer
                (message-cancel-news))
          (gnus-summary-mark-as-read article gnus-canceled-mark)


@@ -1295,26 +1330,27 @@ For the \"inline\" alternatives, also see the variable
                                          group)))
              (message-unquote-tokens
               (message-tokenize-header (mail-fetch-field "gcc" nil t)
                                          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))
     (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"))
             (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))

-           ((stringp gnus-gcc-self-resent-messages)
+           ((stringp self)

             (insert "Gcc: "
                     (mm-encode-coding-string
             (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"))
                     "\n"))

-           ((null gnus-gcc-self-resent-messages)
+           ((null self)

             (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
             (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 "\"")
             (when (setq gcc (delete
                              gnus-newsgroup-name
                              (delete (concat "\"" gnus-newsgroup-name "\"")


@@ -1335,13 +1371,33 @@ 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))
              (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 (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)
     ;; `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
     (dolist (article (gnus-summary-work-articles n))
       (gnus-summary-select-article nil nil nil article)
       (with-current-buffer gnus-original-article-buffer


@@ -1420,33 +1476,6 @@ See `gnus-summary-mail-forward' for ARG."
        (when (gnus-y-or-n-p "Send this complaint? ")
          (message-send-and-exit))))))
 
        (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
 (defun gnus-inews-add-to-address (group)
   (let ((to-address (mail-fetch-field "to")))
     (when (and to-address


@@ -1457,41 +1486,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))))))
 
             (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 group
-                (not (gnus-group-read-only-p group)))
-      (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
-    (when (gnus-group-entry group)
-      (error "No such group: %s" group))
-    (save-excursion
-      (save-restriction
-       (widen)
-       (message-narrow-to-headers)
-       (let ((gnus-deletable-headers nil))
-         (message-generate-headers
-          (if (message-news-p)
-              message-required-news-headers
-            message-required-mail-headers)))
-       (goto-char (point-max))
-       (if (string-match " " group)
-           (insert "Gcc: \"" group "\"\n")
-         (insert "Gcc: " group "\n"))
-       (widen)))
-    (gnus-inews-do-gcc)
-    (when (and (get-buffer gnus-group-buffer)
-              (gnus-buffer-exists-p (car-safe reply))
-              (cdr reply))
-      (set-buffer (car reply))
-      (gnus-summary-mark-article-as-replied (cdr reply)))
-    (when winconf
-      (set-window-configuration winconf))))
-

 (defun gnus-article-mail (yank)
   "Send a reply to the address near point.
 If YANK is non-nil, include the original article."
 (defun gnus-article-mail (yank)
   "Send a reply to the address near point.
 If YANK is non-nil, include the original article."


@@ -1513,7 +1507,6 @@ If YANK is non-nil, include the original article."
     (error "Gnus has been shut down"))
   (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
     (unless (message-mail-user-agent)
     (error "Gnus has been shut down"))
   (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
     (unless (message-mail-user-agent)

-      (delete-other-windows)

       (when gnus-bug-create-help-buffer
        (switch-to-buffer "*Gnus Help Bug*")
        (erase-buffer)
       (when gnus-bug-create-help-buffer
        (switch-to-buffer "*Gnus Help Bug*")
        (erase-buffer)


@@ -1641,7 +1634,9 @@ this is a reply."
              (nnheader-set-temp-buffer " *acc*")
              (setq message-options (with-current-buffer cur message-options))
              (insert-buffer-substring cur)
              (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)
              (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)
              (save-restriction
                (message-narrow-to-headers)
                (let* ((mail-parse-charset message-default-charset)


@@ -1729,17 +1724,19 @@ this is a reply."
           ((functionp var)
            ;; A function.
            (funcall var group))
           ((functionp var)
            ;; A function.
            (funcall var group))

-          (t
+          (group

            ;; An alist of regexps/functions/forms.
            (while (and var
                        (not
                         (setq result
                               (cond
            ;; An alist of regexps/functions/forms.
            (while (and var
                        (not
                         (setq result
                               (cond

-                               ((stringp (caar var))
+                               ((and group
+                                     (stringp (caar var)))

                                 ;; Regexp.
                                 (when (string-match (caar var) group)
                                   (cdar var)))
                                 ;; Regexp.
                                 (when (string-match (caar var) group)
                                   (cdar var)))

-                               ((functionp (car var))
+                               ((and group
+                                     (functionp (car var)))

                                 ;; Function.
                                 (funcall (car var) group))
                                (t
                                 ;; Function.
                                 (funcall (car var) group))
                                (t


@@ -1815,6 +1812,10 @@ this is a reply."
       (when gnus-newsgroup-name
        (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
          (when tmp-style
       (when gnus-newsgroup-name
        (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
          (when tmp-style

+           (dolist (style tmp-style)
+             (when (stringp (cadr style))
+               (setcdr style (list (mm-decode-coding-string (cadr style)
+                                                            'utf-8)))))

            (setq styles (append styles (list (cons ".*" tmp-style)))))))
       ;; Go through all styles and look for matches.
       (dolist (style styles)
            (setq styles (append styles (list (cons ".*" tmp-style)))))))
       ;; Go through all styles and look for matches.
       (dolist (style styles)