T-gnus 6.14.6; synch up with Gnus v5.8.8.
[elisp/gnus.git-] / lisp / gnus-msg.el
index 10ffc1f..391d5b6 100644 (file)
@@ -106,8 +106,11 @@ 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))
+  '(("^\\(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))
@@ -121,7 +124,7 @@ BODY-LIST is a list of charsets which may be encoded using 8bit
 content-transfer encoding in the body, or one of the special values
 nil (always encode using quoted-printable) or t (always use 8bit).
 
-Note that any value other tha nil for HEADER infringes some RFCs, so
+Note that any value other than nil for HEADER infringes some RFCs, so
 use this option with care."
   :type '(repeat (list :tag "Permitted unencoded charsets"
                  (choice :tag "Where"
@@ -209,8 +212,8 @@ Thank you for your help in stamping out bugs.
   "\M-c" gnus-summary-mail-crosspost-complaint
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
-  "Om" gnus-summary-mail-digest
-  "Op" gnus-summary-post-digest)
+  "Om" gnus-uu-digest-mail-forward
+  "Op" gnus-uu-digest-post-forward)
 
 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
   "b" gnus-summary-resend-bounced-mail
@@ -252,6 +255,22 @@ 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
+Gcc: header for archiving purposes."
+  (interactive)
+  (gnus-setup-message 'message
+    (apply 'message-mail args))
+  ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
+  t)
+
+;;;###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 ""))
@@ -269,7 +288,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)))
@@ -482,15 +505,24 @@ header line with the old Message-ID."
          (let ((inhibit-read-only t))
            (copy-to-buffer gnus-article-copy (point-min) (point-max))
            (set-buffer gnus-article-copy)
+           ;; Encode bitmap smileys to ordinary text.
+           ;; Possibly, the original text might be restored.
+           (static-unless (featurep 'xemacs)
+             (when (featurep 'smiley-mule)
+               (smiley-encode-buffer)))
            (gnus-article-delete-text-of-type 'annotation)
            (gnus-remove-text-with-property 'gnus-prev)
            (gnus-remove-text-with-property 'gnus-next)
            (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
            (insert
             (prog1
-                (format "%s" (buffer-string))
-              (erase-buffer)))
-           )
+                (static-if (featurep 'xemacs)
+                    ;; Revome smiley extents for (possibly) XEmacs 21.1.
+                    (format "%s"
+                            (buffer-substring-no-properties (point-min)
+                                                            (point-max)))
+                  (buffer-substring-no-properties (point-min) (point-max)))
+              (erase-buffer))))
          ;; Find the original headers.
          (set-buffer gnus-original-article-buffer)
          (goto-char (point-min))
@@ -502,10 +534,6 @@ header line with the old Message-ID."
          (set-buffer gnus-article-copy)
          (delete-region (goto-char (point-min))
                         (or (search-forward "\n\n" nil t) (point-max)))
-         ;; Encode bitmap smileys to ordinary text.
-         (static-unless (featurep 'xemacs)
-           (when (featurep 'smiley-mule)
-             (smiley-encode-buffer)))
          ;; Insert the original article headers.
          (insert-buffer-substring gnus-original-article-buffer beg end)
          (article-decode-encoded-words)))
@@ -521,6 +549,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)
@@ -531,7 +560,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
@@ -619,7 +649,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
@@ -750,36 +782,36 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
           (if full-headers "" message-included-forward-headers)))
       (message-forward post))))
 
-;;; XXX: generate Subject and ``Topics''?
-(defun gnus-summary-mail-digest (&optional n post)
-  "Digests and forwards all articles in this series."
-  (interactive "P")
-  (let ((subject "Digested Articles")
-       (articles (gnus-summary-work-articles n))
-       article frame)
-    (gnus-setup-message 'forward
-      (gnus-summary-select-article)
-      (if post (message-news nil subject) (message-mail nil subject))
-      (when (and message-use-multi-frames (cdr articles))
-       (setq frame (window-frame (get-buffer-window (current-buffer)))))
-      (message-goto-body)
-      (while (setq article (pop articles))
-       (save-window-excursion
-         (set-buffer gnus-summary-buffer)
-         (gnus-summary-select-article nil nil nil article)
-         (gnus-summary-remove-process-mark article))
-       (when frame
-         (select-frame frame))
-       (insert (mime-make-tag "message" "rfc822") "\n")
-       (insert-buffer-substring gnus-original-article-buffer))
-      (push-mark)
-      (message-goto-body)
-      (mime-edit-enclose-digest-region (point)(mark t)))))
-
-(defun gnus-summary-post-digest (&optional n)
-  "Digest and forwards all articles in this series to a newsgroup."
-  (interactive "P")
-  (gnus-summary-mail-digest n t))
+;;;;; XXX: generate Subject and ``Topics''?
+;;(defun gnus-summary-mail-digest (&optional n post)
+;;  "Digests and forwards all articles in this series."
+;;  (interactive "P")
+;;  (let ((subject "Digested Articles")
+;;     (articles (gnus-summary-work-articles n))
+;;     article frame)
+;;    (gnus-setup-message 'forward
+;;      (gnus-summary-select-article)
+;;      (if post (message-news nil subject) (message-mail nil subject))
+;;      (when (and message-use-multi-frames (cdr articles))
+;;     (setq frame (window-frame (get-buffer-window (current-buffer)))))
+;;      (message-goto-body)
+;;      (while (setq article (pop articles))
+;;     (save-window-excursion
+;;       (set-buffer gnus-summary-buffer)
+;;       (gnus-summary-select-article nil nil nil article)
+;;       (gnus-summary-remove-process-mark article))
+;;     (when frame
+;;       (select-frame frame))
+;;     (insert (mime-make-tag "message" "rfc822") "\n")
+;;     (insert-buffer-substring gnus-original-article-buffer))
+;;      (push-mark)
+;;      (message-goto-body)
+;;      (mime-edit-enclose-digest-region (point)(mark t)))))
+;;
+;;(defun gnus-summary-post-digest (&optional n)
+;;  "Digest and forwards all articles in this series to a newsgroup."
+;;  (interactive "P")
+;;  (gnus-summary-mail-digest n t))
 
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
@@ -977,6 +1009,8 @@ If YANK is non-nil, include the original article."
     (insert (with-temp-buffer
              (gnus-debug)
              (buffer-string)))
+    (let (mime-content-types)
+      (mime-edit-insert-tag "text" "plain"))
     (goto-char (point-min))
     (search-forward "Subject: " nil t)
     (message "")))
@@ -1029,9 +1063,9 @@ The source file has to be in the Emacs load path."
        (point (point))
        file expr olist sym)
     (gnus-message 4 "Please wait while we snoop your variables...")
-    (sit-for 0)
     ;; Go through all the files looking for non-default values for variables.
     (save-excursion
+      (sit-for 0)
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
       (while files
        (erase-buffer)
@@ -1045,9 +1079,7 @@ The source file has to be in the Emacs load path."
            (goto-char (point-min))
            (while (setq expr (ignore-errors (read (current-buffer))))
              (ignore-errors
-               (and (or (eq (car expr) 'defvar)
-                        (eq (car expr) 'defcustom)
-                        (eq (car expr) 'defvoo))
+               (and (memq (car expr) '(defvar defcustom defvoo))
                     (stringp (nth 3 expr))
                     (or (not (boundp (nth 1 expr)))
                         (not (equal (eval (nth 2 expr))
@@ -1055,7 +1087,7 @@ The source file has to be in the Emacs load path."
                     (push (nth 1 expr) olist)))))))
       (kill-buffer (current-buffer)))
     (when (setq olist (nreverse olist))
-      (insert "------------------ Environment follows ------------------\n\n"))
+      (insert ";----------------- Environment follows ------------------\n\n"))
     (while olist
       (if (boundp (car olist))
          (condition-case ()
@@ -1071,13 +1103,17 @@ The source file has to be in the Emacs load path."
             (format "(setq %s 'whatever)\n" (car olist))))
        (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
       (setq olist (cdr olist)))
-    (insert "\n\n")
     ;; Remove any control chars - they seem to cause trouble for some
     ;; mailers.  (Byte-compiled output from the stuff above.)
     (goto-char point)
     (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
-                    t t))))
+                    t t))
+    ;; Break MIME tags purposely.
+    (goto-char point)
+    (while (re-search-forward mime-edit-tag-regexp nil t)
+      (goto-char (1+ (match-beginning 0)))
+      (insert "X"))))
 
 ;;; Treatment of rejected articles.
 ;;; Bounced mail.
@@ -1104,6 +1140,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)
@@ -1118,25 +1169,12 @@ this is a reply."
          (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