2001-01-21 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-msg.el
index 971709a..2b7442b 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -105,7 +105,7 @@ the second with the current group name.")
   "If non-nil, automatically mark Gcc articles as read.")
 
 (defcustom gnus-group-posting-charset-alist
-  '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+  '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
     ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
     (message-this-is-mail nil nil)
     (message-this-is-news nil t))
@@ -143,6 +143,7 @@ use this option with care."
 
 (defvar gnus-message-buffer "*Mail Gnus*")
 (defvar gnus-article-copy nil)
+(defvar gnus-check-before-posting nil)
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
@@ -229,6 +230,7 @@ Thank you for your help in stamping out bugs.
           (progn
             ,@forms)
         (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+        (gnus-inews-insert-draft-meta-information ,group ,article)
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
@@ -245,19 +247,44 @@ Thank you for your help in stamping out bugs.
        (gnus-configure-windows ,config t)
        (set-buffer-modified-p nil))))
 
+(defun gnus-inews-insert-draft-meta-information (group article)
+  (save-excursion
+    (when (and group
+              (not (string= group ""))
+              (not (message-fetch-field gnus-draft-meta-information-header)))
+      (goto-char (point-min))
+      (insert gnus-draft-meta-information-header ": (\"" group "\" "
+             (if article (number-to-string article) "\"\"") ")\n"))))
+
 ;;;###autoload
 (defun gnus-msg-mail (&rest args)
   "Start editing a mail message to be sent.
 Like `message-mail', but with Gnus paraphernalia, particularly the
-the Gcc: header for archiving purposes."
+Gcc: header for archiving purposes."
+  (interactive)
+  (gnus-setup-message 'message
+    (apply 'message-mail args))
+  ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
+  t)
+
+;;;###autoload
+(defun gnus-button-mailto (address)
+  "Mail to ADDRESS."
+  (set-buffer (gnus-copy-article-buffer))
+  (gnus-setup-message 'message
+    (message-reply address)))
+
+;;;###autoload
+(defun gnus-button-reply (&optional to-address wide)
+  "Like `message-reply'."
   (interactive)
   (gnus-setup-message 'message
-    (apply 'message-mail args)))
+    (message-reply to-address wide)))
 
 ;;;###autoload
 (define-mail-user-agent 'gnus-user-agent
-      'gnus-msg-mail 'message-send-and-exit
-      'message-kill-buffer 'message-send-hook)
+  'gnus-msg-mail 'message-send-and-exit
+  'message-kill-buffer 'message-send-hook)
 
 (defun gnus-setup-posting-charset (group)
   (let ((alist gnus-group-posting-charset-alist)
@@ -388,7 +415,10 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
        (gnus-summary-remove-process-mark article))
       (gnus-copy-article-buffer)
       (let ((message-reply-buffer gnus-article-copy)
-           (message-reply-headers gnus-current-headers))
+           (message-reply-headers
+            (with-current-buffer gnus-article-copy
+              ;; The headers are decoded.
+              (nnheader-parse-head t))))
        (message-yank-original)
        (setq beg (or beg (mark t))))
       (when articles
@@ -455,7 +485,7 @@ header line with the old Message-ID."
        (set-buffer article-buffer)
        (let ((gnus-newsgroup-charset (or gnus-article-charset
                                          gnus-newsgroup-charset))
-             (gnus-newsgroup-ignored-charsets 
+             (gnus-newsgroup-ignored-charsets
               (or gnus-article-ignored-charsets
                   gnus-newsgroup-ignored-charsets)))
          (save-restriction
@@ -597,7 +627,9 @@ If SILENT, don't prompt the user."
        (setq method-alist
              (mapcar
               (lambda (m)
-                (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+                (if (equal (cadr m) "")
+                    (list (symbol-name (car m)) m)
+                  (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
               post-methods))
        ;; Query the user.
        (cadr
@@ -626,8 +658,9 @@ If SILENT, don't prompt the user."
 \f
 
 ;; Dummies to avoid byte-compile warning.
-(defvar nnspool-rejected-article-hook)
-(defvar xemacs-codename)
+(eval-when-compile
+  (defvar nnspool-rejected-article-hook)
+  (defvar xemacs-codename))
 
 (defun gnus-extended-version ()
   "Stringified Gnus version and Emacs version."
@@ -703,18 +736,18 @@ The original article will be yanked."
   (gnus-summary-reply-with-original n t))
 
 (defun gnus-summary-mail-forward (&optional arg post)
-  "Forward the current message to another user.  
+  "Forward the current message to another user.
 If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
 if ARG is 1, decode the message and forward directly inline;
-if ARG is 2, foward message as an rfc822 MIME section;
+if ARG is 2, forward message as an rfc822 MIME section;
 if ARG is 3, decode message and forward as an rfc822 MIME section;
-if ARG is 4, foward message directly inline;
+if ARG is 4, forward message directly inline;
 otherwise, use flipped `message-forward-as-mime'.
 If POST, post instead of mail."
   (interactive "P")
   (let ((message-forward-as-mime message-forward-as-mime)
        (message-forward-show-mml message-forward-show-mml))
-    (cond 
+    (cond
      ((null arg))
      ((eq arg 1) (setq message-forward-as-mime nil
                       message-forward-show-mml t))
@@ -728,28 +761,15 @@ If POST, post instead of mail."
     (gnus-setup-message 'forward
       (gnus-summary-select-article)
       (let ((mail-parse-charset gnus-newsgroup-charset)
-           (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
-           text)
-       (save-excursion
-         (set-buffer gnus-original-article-buffer)
-         (setq text (buffer-string)))
-       (set-buffer 
-        (gnus-get-buffer-create
-         (generate-new-buffer-name " *Gnus forward*")))
-       (erase-buffer)
-       (unless message-forward-show-mml
-         (mm-disable-multibyte))
-       (insert text)
-       (goto-char (point-min))
-       (when (looking-at "From ")
-         (replace-match "X-From-Line: ") )
-       (when message-forward-show-mml
-         (mime-to-mml))
+           (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+       (set-buffer gnus-original-article-buffer)
        (message-forward post)))))
 
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
-  (interactive "sResend message(s) to: \nP")
+  (interactive
+   (list (message-read-from-minibuffer "Resend message(s) to: ")
+        current-prefix-arg))
   (let ((articles (gnus-summary-work-articles n))
        article)
     (while (setq article (pop articles))
@@ -915,15 +935,17 @@ If YANK is non-nil, include the original article."
   (interactive)
   (unless (gnus-alive-p)
     (error "Gnus has been shut down"))
-  (gnus-setup-message 'bug
-    (delete-other-windows)
-    (when gnus-bug-create-help-buffer
-      (switch-to-buffer "*Gnus Help Bug*")
-      (erase-buffer)
-      (insert gnus-bug-message)
-      (goto-char (point-min)))
-    (message-pop-to-buffer "*Gnus Bug*")
-    (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+  (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)
+       (insert gnus-bug-message)
+       (goto-char (point-min)))
+      (message-pop-to-buffer "*Gnus Bug*"))
+    (let ((message-this-is-mail t))
+      (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
     (when gnus-bug-create-help-buffer
       (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))
@@ -1098,19 +1120,39 @@ this is a reply."
                       (concat "^" (regexp-quote mail-header-separator) "$")
                       nil t)
                  (replace-match "" t t ))
-               (unless (setq group-art 
+               (unless (setq group-art
                              (gnus-request-accept-article group method t t))
                  (gnus-message 1 "Couldn't store article in group %s: %s"
                                group (gnus-status-message method))
                  (sit-for 2))
-               (when gnus-inews-mark-gcc-as-read
+               (when (and group-art gnus-inews-mark-gcc-as-read)
                  (let ((active (gnus-active group)))
-                   (when active
-                     (if (< (cdr active) (cdr group-art))
-                         (gnus-set-active group (cons (car active) 
-                                                      (cdr group-art))))
-                     (gnus-group-make-articles-read group 
-                                                    (list (cdr group-art))))))
+                   (if active
+                       (if (< (cdr active) (cdr group-art))
+                           (gnus-set-active group (cons (car active)
+                                                        (cdr group-art))))
+                     (gnus-activate-group group)))
+                 (let ((buffer (gnus-summary-buffer-name group))
+                       (mark gnus-read-mark)
+                       (article (cdr group-art)))
+                   (unless
+                       (and
+                        (get-buffer buffer)
+                        (with-current-buffer buffer
+                          (when gnus-newsgroup-prepared
+                            (when (and gnus-newsgroup-auto-expire
+                                       (memq mark gnus-auto-expirable-marks))
+                              (setq mark gnus-expirable-mark))
+                            (setq mark (gnus-request-update-mark
+                                        group article mark))
+                            (gnus-mark-article-as-read article mark)
+                            (setq gnus-newsgroup-active (gnus-active group))
+                            t)))
+                     (gnus-group-make-articles-read group
+                                                    (list article))
+                     (when (gnus-group-auto-expirable-p group)
+                       (gnus-add-marked-articles
+                        group 'expire (list article))))))
                (kill-buffer (current-buffer))))))))))
 
 (defun gnus-inews-insert-gcc ()