2003-02-12 Michael Shields <shields@msrl.com>
[gnus] / lisp / gnus-msg.el
index a1da229..b22d3ef 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -235,14 +235,14 @@ This variable is used only when `gnus-post-method' is `current'."
 
 (defcustom gnus-message-replysign
   nil
-  "Automatically sign replys to signed messages.
+  "Automatically sign replies to signed messages.
 See also the `mml-default-sign-method' variable."
   :group 'gnus-message
   :type 'boolean)
 
 (defcustom gnus-message-replyencrypt
   nil
-  "Automatically encrypt replys to encrypted messages.
+  "Automatically encrypt replies to encrypted messages.
 See also the `mml-default-encrypt-method' variable."
   :group 'gnus-message
   :type 'boolean)
@@ -256,7 +256,23 @@ See also the `mml-default-encrypt-method' variable."
 (defcustom gnus-confirm-mail-reply-to-news nil
   "If non-nil, Gnus requests confirmation when replying to news.
 This is done because new users often reply by mistake when reading
-news."
+news.
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
+  :group 'gnus-message
+  :type '(choice (const :tag "No" nil)
+                (const :tag "Yes" t)
+                (regexp :tag "Iff group matches regexp")
+                (function :tag "Iff function evaluates to non-nil")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+  nil
+  "If non-nil, Gnus will treat mail like news with regard to confirmation
+when replying by mail.  See the `gnus-confirm-mail-reply-to-news' variable
+for fine-tuning this.
+If nil, Gnus will never ask for confirmation if replying to mail."
   :group 'gnus-message
   :type 'boolean)
 
@@ -267,6 +283,11 @@ 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'."
+  :group 'gnus-message
+  :type 'boolean)
+
 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
@@ -348,6 +369,11 @@ Thank you for your help in stamping out bugs.
 
 ;;; Internal functions.
 
+(defun gnus-inews-make-draft ()
+  `(lambda ()
+     (gnus-inews-make-draft-meta-information
+      ,gnus-newsgroup-name ',gnus-article-reply)))
+
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
@@ -381,10 +407,9 @@ Thank you for your help in stamping out bugs.
                  message-required-headers)
        (when (and ,group
                  (not (string= ,group "")))
-        (push '(,(intern gnus-draft-meta-information-header)
-                . (lambda ()
-                    (gnus-inews-make-draft-meta-information
-                     ,gnus-newsgroup-name ,gnus-article-reply)))
+        (push (cons
+               (intern gnus-draft-meta-information-header)
+               (gnus-inews-make-draft))
               message-required-headers))
        (unwind-protect
           (progn
@@ -496,15 +521,19 @@ Gcc: header for archiving purposes."
   (setq message-newsreader (setq message-mailer (gnus-extended-version)))
   (message-add-action
    `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
-  (message-add-action
-   `(when (gnus-buffer-exists-p ,buffer)
-      (save-excursion
-       (set-buffer ,buffer)
-       ,(when article
-          (if (eq config 'forward)
-              `(gnus-summary-mark-article-as-forwarded ',yanked)
-            `(gnus-summary-mark-article-as-replied ',yanked)))))
-   'send))
+  (let ((to-be-marked (cond
+                      (yanked yanked)
+                      (article (if (listp article) article (list article)))
+                      (t nil))))
+    (message-add-action
+     `(when (gnus-buffer-exists-p ,buffer)
+       (save-excursion
+         (set-buffer ,buffer)
+         ,(when to-be-marked
+            (if (eq config 'forward)
+                `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+              `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+     'send)))
 
 (put 'gnus-setup-message 'lisp-indent-function 1)
 (put 'gnus-setup-message 'edebug-form-spec '(form body))
@@ -586,7 +615,8 @@ a news."
           ""))
        ;; make sure last viewed article doesn't affect posting styles:
        (gnus-article-copy))
-    (gnus-post-news 'post gnus-newsgroup-name)))
+    (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
+                   (string= gnus-newsgroup-name ""))))
 
 (defun gnus-summary-mail-other-window (&optional arg)
   "Start composing a mail in another window.
@@ -997,13 +1027,15 @@ If SILENT, don't prompt the user."
   "Stringified Gnus version and Emacs version."
   (interactive)
   (concat
-   "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
+   "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)
-            " (" system-configuration ")"))
+            (if gnus-version-expose-system
+                " (" system-configuration ")"
+              "")))
     ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
                   emacs-version)
      (concat (match-string 1 emacs-version)
@@ -1012,8 +1044,10 @@ If SILENT, don't prompt the user."
                 (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))))
 
 \f
@@ -1033,9 +1067,16 @@ If VERY-WIDE, make a very wide reply."
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
   ;; Allow user to require confirmation before replying by mail to the
-  ;; author of a news article.
-  (when (or (not (gnus-news-group-p gnus-newsgroup-name))
-           (not gnus-confirm-mail-reply-to-news)
+  ;; author of a news article (or mail message).
+  (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)
+                       (string-match gnus-confirm-mail-reply-to-news
+                                     gnus-newsgroup-name))
+                      ((functionp gnus-confirm-mail-reply-to-news)
+                       (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+                      (t gnus-confirm-mail-reply-to-news)))
            (y-or-n-p "Really reply by mail to article author? "))
     (let* ((article
            (if (listp (car yank))
@@ -1480,17 +1521,15 @@ The source file has to be in the Emacs load path."
       (insert "------------------ Environment follows ------------------\n\n"))
     (while olist
       (if (boundp (car olist))
-         (condition-case ()
-             (pp `(setq ,(car olist)
-                        ,(if (or (consp (setq sym (symbol-value (car olist))))
-                                 (and (symbolp sym)
-                                      (not (or (eq sym nil)
-                                               (eq sym t)))))
-                             (list 'quote (symbol-value (car olist)))
-                           (symbol-value (car olist))))
-                 (current-buffer))
-           (error
-            (format "(setq %s 'whatever)\n" (car olist))))
+         (ignore-errors
+           (pp `(setq ,(car olist)
+                      ,(if (or (consp (setq sym (symbol-value (car olist))))
+                               (and (symbolp sym)
+                                    (not (or (eq sym nil)
+                                             (eq sym t)))))
+                           (list 'quote (symbol-value (car olist)))
+                         (symbol-value (car olist))))
+               (current-buffer)))
        (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
       (setq olist (cdr olist)))
     (insert "\n\n")
@@ -1609,6 +1648,9 @@ this is a reply."
                              group (gnus-status-message method))
                (sit-for 2))
              (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
                             gnus-inews-mark-gcc-as-read))
                (gnus-group-mark-article-read group (cdr group-art)))
@@ -1856,7 +1898,9 @@ this is a reply."
                           (let ((value ,(cdr result)))
                             (when value
                               (message-goto-eoh)
-                              (insert ,header ": " value "\n"))))))))
+                              (insert ,header ": " value)
+                              (unless (bolp)
+                                (insert "\n")))))))))
                  nil 'local))
       (when (or name address)
        (add-hook 'message-setup-hook