* nnmail.el (nnmail-cache-insert): make sure that the
[gnus] / lisp / gnus-msg.el
index a7476bc..bcfffb8 100644 (file)
@@ -33,6 +33,7 @@
 (require 'gnus-ems)
 (require 'message)
 (require 'gnus-art)
+(require 'gnus-util)
 
 (defcustom gnus-post-method 'current
   "*Preferred method for posting USENET news.
@@ -69,12 +70,13 @@ of names)."
                 (function)))
 
 (defcustom gnus-mailing-list-groups nil
-  "*Regexp matching groups that are really mailing lists.
+  "*If non-nil a 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."
   :group 'gnus-message
-  :type 'regexp)
+  :type '(choice (regexp)
+                (const nil)))
 
 (defcustom gnus-add-to-list nil
   "*If non-nil, add a `to-list' parameter automatically."
@@ -144,9 +146,6 @@ See Info node `(gnus)Posting Styles'."
   :group 'gnus-message
   :type 'boolean)
 
-(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
                        'gnus-gcc-mark-as-read)
 
@@ -249,7 +248,7 @@ See also the `mml-default-encrypt-method' variable."
 
 (defcustom gnus-message-replysignencrypted
   t
-  "Setting this causes automatically encryped messages to also be signed."
+  "Setting this causes automatically encrypted messages to also be signed."
   :group 'gnus-message
   :type 'boolean)
 
@@ -283,10 +282,23 @@ If nil, the address field will always be empty after invoking
   :group 'gnus-message
   :type 'boolean)
 
-(defcustom gnus-version-expose-system nil
-  "If non-nil, `system-configuration' is exposed in `gnus-extended-version'."
+(defcustom gnus-user-agent 'emacs-gnus-type
+  "Which information should be exposed in the User-Agent header.
+
+It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
+\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
+`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
+`emacs-gnus' plus system type\) or a custom string.  If you set it to a
+string, be sure to use a valid format, see RFC 2616."
   :group 'gnus-message
-  :type 'boolean)
+  :type '(choice
+         (item :tag "Show Gnus and Emacs versions and system type"
+               emacs-gnus-type)
+         (item :tag "Show Gnus and Emacs versions and system configuration"
+               emacs-gnus-config)
+         (item :tag "Show Gnus and Emacs versions" emacs-gnus)
+         (item :tag "Show only Gnus version" gnus)
+         (string :tag "Other")))
 
 ;;; Internal variables.
 
@@ -425,14 +437,13 @@ Thank you for your help in stamping out bugs.
             (let ((mbl1 mml-buffer-list))
               (setq mml-buffer-list mbl)  ;; Global value
               (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
-              ;; LOCAL argument of add-hook differs between GNU Emacs
-              ;; and XEmacs. make-local-hook makes sure they are local.
-              (make-local-hook 'kill-buffer-hook)
-              (make-local-hook 'change-major-mode-hook)
+              (gnus-make-local-hook 'kill-buffer-hook)
+              (gnus-make-local-hook 'change-major-mode-hook)
               (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
               (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
           (mml-destroy-buffers)
           (setq mml-buffer-list mbl)))
+       (message-hide-headers)
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
        (run-hooks 'post-command-hook)
@@ -501,7 +512,7 @@ Gcc: header for archiving purposes."
        (while (setq elem (pop alist))
          (when (or (and (stringp (car elem))
                         (string-match (car elem) group))
-                   (and (gnus-functionp (car elem))
+                   (and (functionp (car elem))
                         (funcall (car elem) group))
                    (and (symbolp (car elem))
                         (symbol-value (car elem))))
@@ -509,18 +520,20 @@ Gcc: header for archiving purposes."
 
 (defun gnus-inews-add-send-actions (winconf buffer article
                                            &optional config yanked)
-  (make-local-hook 'message-sent-hook)
+  (gnus-make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
                                 'gnus-inews-do-gcc) nil t)
   (when gnus-agent
-    (make-local-hook 'message-header-hook)
+    (gnus-make-local-hook 'message-header-hook)
     (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
   (setq message-post-method
        `(lambda (arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))
   (setq message-newsreader (setq message-mailer (gnus-extended-version)))
   (message-add-action
-   `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+   `(when (gnus-buffer-exists-p ,buffer)
+      (set-window-configuration ,winconf))
+   'exit 'postpone 'kill)
   (let ((to-be-marked (cond
                       (yanked yanked)
                       (article (if (listp article) article (list article)))
@@ -574,7 +587,7 @@ If ARG is 1, prompt for group name to post to.
 
 This function prepares a news even when using mail groups.  This is useful
 for posting messages to mail groups without actually sending them over the
-network.  The corresponding backend must have a 'request-post method."
+network.  The corresponding back end must have a 'request-post method."
   (interactive "P")
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
@@ -653,7 +666,7 @@ If ARG, don't do that.  If ARG is 1, prompt for group name to post to.
 
 This function prepares a news even when using mail groups.  This is useful
 for posting messages to mail groups without actually sending them over the
-network.  The corresponding backend must have a 'request-post method."
+network.  The corresponding back end must have a 'request-post method."
   (interactive "P")
   ;; We can't `let' gnus-newsgroup-name here, since that leads
   ;; to local variables leaking.
@@ -673,7 +686,12 @@ network.  The corresponding backend must have a 'request-post method."
                  gnus-newsgroup-name))
          ;; #### see comment in gnus-setup-message -- drv
          (gnus-setup-message 'message
-           (message-news (gnus-group-real-name gnus-newsgroup-name))))
+           (progn
+             (message-news (gnus-group-real-name gnus-newsgroup-name))
+             (set (make-local-variable 'gnus-discouraged-post-methods)
+                  (delq
+                   (car (gnus-find-method-for-group gnus-newsgroup-name))
+                   (copy-sequence gnus-discouraged-post-methods))))))
       (save-excursion
        (set-buffer buffer)
        (setq gnus-newsgroup-name group)))))
@@ -1020,37 +1038,20 @@ If SILENT, don't prompt the user."
 
 \f
 
-;; Dummies to avoid byte-compile warning.
-(eval-when-compile
-  (defvar nnspool-rejected-article-hook)
-  (defvar xemacs-codename))
-
 (defun gnus-extended-version ()
-  "Stringified Gnus version and Emacs version."
+  "Stringified Gnus version and Emacs version.
+See the variable `gnus-user-agent'."
   (interactive)
-  (concat
-   "Gnus/" (gnus-prin1-to-string (gnus-continuum-version gnus-version))
-   " (" gnus-version ")"
-   " "
-   (cond
-    ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
-     (concat "Emacs/" (match-string 1 emacs-version)
-            (if gnus-version-expose-system
-                " (" system-configuration ")"
-              "")))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
-                  emacs-version)
-     (concat (match-string 1 emacs-version)
-            (format "/%d.%d" emacs-major-version emacs-minor-version)
-            (if (match-beginning 3)
-                (match-string 3 emacs-version)
-              "")
-            (if (boundp 'xemacs-codename)
-            (if gnus-version-expose-system
-                (concat " (" xemacs-codename ", " system-configuration ")")
-              (concat " (" xemacs-codename ")"))
-            "")))
-    (t emacs-version))))
+  (let* ((gnus-v
+         (concat "Gnus/"
+                 (prin1-to-string (gnus-continuum-version gnus-version) t)
+                 " (" gnus-version ")"))
+        (emacs-v (gnus-emacs-version)))
+    (if (stringp gnus-user-agent)
+       gnus-user-agent
+      (concat gnus-v
+             (when emacs-v
+               (concat " " emacs-v))))))
 
 \f
 ;;;
@@ -1070,7 +1071,7 @@ If VERY-WIDE, make a very wide reply."
              (gnus-summary-work-articles 1))))
   ;; Allow user to require confirmation before replying by mail to the
   ;; author of a news article (or mail message).
-  (when (or 
+  (when (or
            (not (or (gnus-news-group-p gnus-newsgroup-name)
                     gnus-confirm-treat-mail-like-news))
            (not (cond ((stringp gnus-confirm-mail-reply-to-news)
@@ -1166,7 +1167,8 @@ automatically."
 
 (defun gnus-summary-wide-reply-with-original (n)
   "Start composing a wide reply mail to the current message.
-The original article will be yanked."
+The original article will be yanked.
+Uses the process/prefix convention."
   (interactive "P")
   (gnus-summary-reply-with-original n t))
 
@@ -1273,7 +1275,6 @@ composing a new message."
        ;; 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")
@@ -1282,8 +1283,8 @@ composing a new message."
        (goto-char (point-max))
        (insert mail-header-separator)
        (goto-char (point-min))
-       (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
-       (forward-char 1)
+       (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+         (forward-char 1))
        (widen)))))
 
 (defun gnus-summary-post-forward (&optional arg)
@@ -1379,7 +1380,7 @@ The current group name will be inserted at \"%s\".")
       ;; This mail group doesn't have a `to-list', so we add one
       ;; here.  Magic!
       (when (gnus-y-or-n-p
-            (format "Do you want to add this as `to-list': %s " 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 ()
@@ -1547,7 +1548,7 @@ The source file has to be in the Emacs load path."
 
 (defun gnus-summary-resend-bounced-mail (&optional fetch)
   "Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
 contains some mail you have written which has been bounced back to
 you.
 If FETCH, try to fetch the article that this is a reply to, if indeed
@@ -1654,7 +1655,9 @@ this is a reply."
                         ;; Gnus is not running?
                         (gnus-alive-p)
                         (or gnus-gcc-mark-as-read
-                            gnus-inews-mark-gcc-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)))
              (kill-buffer (current-buffer)))))))))
 
@@ -1665,7 +1668,7 @@ this is a reply."
       (message-narrow-to-headers)
       (let* ((group gnus-outgoing-message-group)
             (gcc (cond
-                  ((gnus-functionp group)
+                  ((functionp group)
                    (funcall group))
                   ((or (stringp group) (list group))
                    group))))
@@ -1706,7 +1709,7 @@ this is a reply."
           ((and (listp var) (stringp (car var)))
            ;; A list of groups.
            var)
-          ((gnus-functionp var)
+          ((functionp var)
            ;; A function.
            (funcall var group))
           (t
@@ -1719,7 +1722,7 @@ this is a reply."
                                 ;; Regexp.
                                 (when (string-match (caar var) group)
                                   (cdar var)))
-                               ((gnus-functionp (car var))
+                               ((functionp (car var))
                                 ;; Function.
                                 (funcall (car var) group))
                                (t
@@ -1743,14 +1746,17 @@ this is a reply."
                     (if (string-match " " gcc-self-val)
                         (concat "\"" gcc-self-val "\"")
                       gcc-self-val)
-                  (if (string-match " " group)
-                      (concat "\"" group "\"")
-                    group)))
+                  ;; In nndoc groups, we use the parent group name
+                  ;; instead of the current group.
+                  (let ((group (or (gnus-group-find-parameter
+                                    gnus-newsgroup-name 'parent-group)
+                                   group)))
+                    (if (string-match " " group)
+                        (concat "\"" group "\"")
+                      group))))
                (if (not (eq gcc-self-val 'none))
                    (insert "\n")
-                 (progn
-                   (beginning-of-line)
-                   (kill-line))))
+                 (gnus-delete-line)))
            ;; Use the list of groups.
            (while (setq name (pop groups))
              (let ((str (if (string-match ":" name)
@@ -1781,7 +1787,7 @@ this is a reply."
   (unless gnus-inhibit-posting-styles
     (let ((group (or group-name gnus-newsgroup-name ""))
          (styles gnus-posting-styles)
-         style match variable attribute value v results
+         style match attribute value v results
          filep name address element)
       ;; If the group has a posting-style parameter, add it at the end with a
       ;; regexp matching everything, to be sure it takes precedence over all
@@ -1806,9 +1812,9 @@ this is a reply."
                         (and header
                              (string-match (pop style) header))))))
               ((or (symbolp match)
-                   (gnus-functionp match))
+                   (functionp match))
                (cond
-                ((gnus-functionp match)
+                ((functionp match)
                  ;; Function to be called.
                  (funcall match))
                 ((boundp match)
@@ -1829,7 +1835,6 @@ this is a reply."
          ;; We have a match, so we set the variables.
          (dolist (attribute style)
            (setq element (pop attribute)
-                 variable nil
                  filep nil)
            (setq value
                  (cond
@@ -1846,8 +1851,8 @@ this is a reply."
                   ((stringp value)
                    value)
                   ((or (symbolp value)
-                       (gnus-functionp value))
-                   (cond ((gnus-functionp value)
+                       (functionp value))
+                   (cond ((functionp value)
                           (funcall value))
                          ((boundp value)
                           (symbol-value value))))
@@ -1875,8 +1880,7 @@ this is a reply."
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
-      ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
-      (make-local-hook 'message-setup-hook)
+      (gnus-make-local-hook 'message-setup-hook)
       (setq results (sort results (lambda (x y)
                                    (string-lessp (car x) (car y)))))
       (dolist (result results)