2000-11-12 23:36:45 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-msg.el
index fc7e57a..971709a 100644 (file)
@@ -101,6 +101,9 @@ the second with the current group name.")
 (defvar gnus-posting-styles nil
   "*Alist of styles to use when posting.")
 
+(defvar gnus-inews-mark-gcc-as-read nil
+  "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))
     ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
@@ -232,12 +235,9 @@ Thank you for your help in stamping out bugs.
         (set (make-local-variable 'gnus-newsgroup-name) ,group)
         (gnus-run-hooks 'gnus-message-setup-hook)
         (if (eq major-mode 'message-mode)
-            ;; Make mml-buffer-list local.
-            ;; Restore global mml-buffer-list value as mbl.
-            ;; What a hack! -- Shenghuo
-            (let ((mml-buffer-list mml-buffer-list))
-              (setq mml-buffer-list mbl)
-              (make-local-variable 'mml-buffer-list)
+            (let ((mbl1 mml-buffer-list))
+              (setq mml-buffer-list mbl)  ;; Global value
+              (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
               (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
           (mml-destroy-buffers)
           (setq mml-buffer-list mbl)))
@@ -245,6 +245,20 @@ Thank you for your help in stamping out bugs.
        (gnus-configure-windows ,config t)
        (set-buffer-modified-p nil))))
 
+;;;###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."
+  (interactive)
+  (gnus-setup-message 'message
+    (apply 'message-mail args)))
+
+;;;###autoload
+(define-mail-user-agent 'gnus-user-agent
+      '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)
        (group (or group ""))
@@ -262,7 +276,11 @@ Thank you for your help in stamping out bugs.
 
 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
-  (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+  (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)
+    (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)))
@@ -435,33 +453,38 @@ header line with the old Message-ID."
        (error "Can't find any article buffer")
       (save-excursion
        (set-buffer article-buffer)
-       (save-restriction
-         ;; Copy over the (displayed) article buffer, delete
-         ;; hidden text and remove text properties.
-         (widen)
-         (copy-to-buffer gnus-article-copy (point-min) (point-max))
-         (set-buffer gnus-article-copy)
-         (gnus-article-delete-text-of-type 'annotation)
-         (gnus-remove-text-with-property 'gnus-prev)
-         (gnus-remove-text-with-property 'gnus-next)
-         (insert
-          (prog1
-              (format "%s" (buffer-string))
-            (erase-buffer)))
-         ;; Find the original headers.
-         (set-buffer gnus-original-article-buffer)
-         (goto-char (point-min))
-         (while (looking-at message-unix-mail-delimiter)
-           (forward-line 1))
-         (setq beg (point))
-         (setq end (or (search-forward "\n\n" nil t) (point)))
-         ;; Delete the headers from the displayed articles.
-         (set-buffer gnus-article-copy)
-         (delete-region (goto-char (point-min))
-                        (or (search-forward "\n\n" nil t) (point-max)))
-         ;; Insert the original article headers.
-         (insert-buffer-substring gnus-original-article-buffer beg end)
-         (article-decode-encoded-words)))
+       (let ((gnus-newsgroup-charset (or gnus-article-charset
+                                         gnus-newsgroup-charset))
+             (gnus-newsgroup-ignored-charsets 
+              (or gnus-article-ignored-charsets
+                  gnus-newsgroup-ignored-charsets)))
+         (save-restriction
+           ;; Copy over the (displayed) article buffer, delete
+           ;; hidden text and remove text properties.
+           (widen)
+           (copy-to-buffer gnus-article-copy (point-min) (point-max))
+           (set-buffer gnus-article-copy)
+           (gnus-article-delete-text-of-type 'annotation)
+           (gnus-remove-text-with-property 'gnus-prev)
+           (gnus-remove-text-with-property 'gnus-next)
+           (insert
+            (prog1
+                (buffer-substring-no-properties (point-min) (point-max))
+              (erase-buffer)))
+           ;; Find the original headers.
+           (set-buffer gnus-original-article-buffer)
+           (goto-char (point-min))
+           (while (looking-at message-unix-mail-delimiter)
+             (forward-line 1))
+           (setq beg (point))
+           (setq end (or (search-forward "\n\n" nil t) (point)))
+           ;; Delete the headers from the displayed articles.
+           (set-buffer gnus-article-copy)
+           (delete-region (goto-char (point-min))
+                          (or (search-forward "\n\n" nil t) (point-max)))
+           ;; Insert the original article headers.
+           (insert-buffer-substring gnus-original-article-buffer beg end)
+           (article-decode-encoded-words))))
       gnus-article-copy)))
 
 (defun gnus-post-news (post &optional group header article-buffer yank subject
@@ -474,6 +497,7 @@ header line with the old Message-ID."
                              (article-buffer 'reply)
                              (t 'message))
       (let* ((group (or group gnus-newsgroup-name))
+            (charset (gnus-group-name-charset nil group))
             (pgroup group)
             to-address to-group mailing-list to-list
             newsgroup-p)
@@ -484,7 +508,8 @@ header line with the old Message-ID."
                newsgroup-p (gnus-group-find-parameter group 'newsgroup)
                mailing-list (when gnus-mailing-list-groups
                               (string-match gnus-mailing-list-groups group))
-               group (gnus-group-real-name group)))
+               group (gnus-group-name-decode (gnus-group-real-name group)
+                                             charset)))
        (if (or (and to-group
                     (gnus-news-group-p to-group))
                newsgroup-p
@@ -648,6 +673,10 @@ automatically."
       (gnus-summary-select-article)
       (set-buffer (gnus-copy-article-buffer))
       (gnus-msg-treat-broken-reply-to)
+      (save-restriction
+       (message-narrow-to-head)
+       (goto-char (point-max)))
+      (mml-quote-region (point) (point-max))
       (message-reply nil wide)
       (when yank
        (gnus-inews-yank-articles yank)))))
@@ -703,19 +732,18 @@ If POST, post instead of mail."
            text)
        (save-excursion
          (set-buffer gnus-original-article-buffer)
-         (mm-with-unibyte-current-buffer
-           (setq text (buffer-string))))
+         (setq text (buffer-string)))
        (set-buffer 
         (gnus-get-buffer-create
          (generate-new-buffer-name " *Gnus forward*")))
        (erase-buffer)
-       (mm-disable-multibyte)
+       (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
-         (mm-enable-multibyte)
          (mime-to-mml))
        (message-forward post)))))
 
@@ -1018,6 +1046,21 @@ this is a reply."
 
 ;;; Gcc handling.
 
+(defun gnus-inews-group-method (group)
+  (cond ((and (null (gnus-get-info group))
+             (eq (car gnus-message-archive-method)
+                 (car
+                  (gnus-server-to-method
+                   (gnus-group-method group)))))
+        ;; If the group doesn't exist, we assume
+        ;; it's an archive group...
+        gnus-message-archive-method)
+       ;; Use the method.
+       ((gnus-info-method (gnus-get-info group))
+        (gnus-info-method (gnus-get-info group)))
+       ;; Find the method.
+       (t (gnus-group-method group))))
+
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
   (interactive)
@@ -1027,29 +1070,16 @@ this is a reply."
        (message-narrow-to-headers)
        (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
              (cur (current-buffer))
-             groups group method)
+             groups group method group-art)
          (when gcc
            (message-remove-header "gcc")
            (widen)
-           (setq groups (message-tokenize-header gcc " ,"))
+           (setq groups (message-unquote-tokens
+                          (message-tokenize-header gcc " ,")))
            ;; Copy the article over to some group(s).
            (while (setq group (pop groups))
              (gnus-check-server
-              (setq method
-                    (cond ((and (null (gnus-get-info group))
-                                (eq (car gnus-message-archive-method)
-                                    (car
-                                     (gnus-server-to-method
-                                      (gnus-group-method group)))))
-                           ;; If the group doesn't exist, we assume
-                           ;; it's an archive group...
-                           gnus-message-archive-method)
-                          ;; Use the method.
-                          ((gnus-info-method (gnus-get-info group))
-                           (gnus-info-method (gnus-get-info group)))
-                          ;; Find the method.
-                          (t (gnus-group-method group)))))
-             (gnus-check-server method)
+              (setq method (gnus-inews-group-method group)))
              (unless (gnus-request-group group t method)
                (gnus-request-create-group group method))
              (save-excursion
@@ -1058,17 +1088,29 @@ this is a reply."
                (message-encode-message-body)
                (save-restriction
                  (message-narrow-to-headers)
-                 (let ((mail-parse-charset message-default-charset))
+                 (let ((mail-parse-charset message-default-charset)
+                       (rfc2047-header-encoding-alist
+                        (cons '("Newsgroups" . default)
+                              rfc2047-header-encoding-alist)))
                    (mail-encode-encoded-word-buffer)))
                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")
                       nil t)
                  (replace-match "" t t ))
-               (unless (gnus-request-accept-article group method t t)
+               (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
+                 (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))))))
                (kill-buffer (current-buffer))))))))))
 
 (defun gnus-inews-insert-gcc ()