Import Oort Gnus v0.09.
[elisp/gnus.git-] / lisp / gnus-msg.el
index 13a2e2c..d3238d4 100644 (file)
@@ -115,6 +115,7 @@ the second with the current group name."
   "*Alist of styles to use when posting.
 See Info node `(gnus)Posting Styles'."
   :group 'gnus-message
+  :link '(custom-manual "(gnus)Posting Styles")
   :type '(repeat (cons (choice (regexp)
                               (variable)
                               (list (const header)
@@ -153,18 +154,25 @@ See Info node `(gnus)Posting Styles'."
   "Should local-file attachments be included as external parts in Gcc copies?
 If it is `all', attach files as external parts;
 if a regexp and matches the Gcc group name, attach files as external parts;
-If nil, attach files as normal parts."
+if nil, attach files as normal parts."
   :version "21.1"
   :group 'gnus-message
   :type '(choice (const nil :tag "None")
                 (const all :tag "Any")
                 (string :tag "Regexp")))
 
-(defcustom gnus-group-posting-charset-alist
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
   '(("^\\(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))
+ :variable-document
   "Alist of regexps and permitted unencoded charsets for posting.
 Each element of the alist has the form (TEST HEADER BODY-LIST), where
 TEST is either a regular expression matching the newsgroup header or a
@@ -177,20 +185,26 @@ nil (always encode using quoted-printable) or t (always use 8bit).
 
 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"
-                  (regexp :tag "Group")
-                  (const :tag "Mail message" :value message-this-is-mail)
-                  (const :tag "News article" :value message-this-is-news))
-                 (choice :tag "Header"
-                  (const :tag "None" nil)
-                  (symbol :tag "Charset"))
-                 (choice :tag "Body"
-                         (const :tag "Any" :value t)
-                         (const :tag "None" :value nil)
-                         (repeat :tag "Charsets"
-                                 (symbol :tag "Charset")))))
-  :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+               (choice :tag "Where"
+                       (regexp :tag "Group")
+                       (const :tag "Mail message" :value message-this-is-mail)
+                       (const :tag "News article" :value message-this-is-news))
+               (choice :tag "Header"
+                       (const :tag "None" nil)
+                       (symbol :tag "Charset"))
+               (choice :tag "Body"
+                       (const :tag "Any" :value t)
+                       (const :tag "None" :value nil)
+                       (repeat :tag "Charsets"
+                               (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+                         :value nil
+                         (repeat (symbol)))
+ :parameter-document       "\
+List of charsets that are permitted to be unencoded.")
 
 (defcustom gnus-debug-files
   '("gnus.el" "gnus-sum.el" "gnus-group.el"
@@ -258,6 +272,7 @@ If nil, the address field will always be empty after invoking
 (defvar gnus-inhibit-posting-styles nil
   "Inhibit the use of posting styles.")
 
+(defvar gnus-article-yanked-articles nil)
 (defvar gnus-message-buffer "*Mail Gnus*")
 (defvar gnus-article-copy nil)
 (defvar gnus-check-before-posting nil)
@@ -333,15 +348,22 @@ 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"))
        (buffer (make-symbol "gnus-setup-message-buffer"))
        (article (make-symbol "gnus-setup-message-article"))
+       (yanked (make-symbol "gnus-setup-yanked-articles"))
        (group (make-symbol "gnus-setup-message-group")))
     `(let ((,winconf (current-window-configuration))
           (,buffer (buffer-name (current-buffer)))
           (,article gnus-article-reply)
+          (,yanked gnus-article-yanked-articles)
           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
@@ -360,11 +382,19 @@ Thank you for your help in stamping out bugs.
        (add-hook 'message-mode-hook
                 (lambda ()
                   (gnus-configure-posting-styles ,group)))
+       (gnus-pull ',(intern gnus-draft-meta-information-header)
+                 message-required-headers)
+       (when (and ,group
+                 (not (string= ,group "")))
+        (push (cons
+               (intern gnus-draft-meta-information-header)
+               (gnus-inews-make-draft))
+              message-required-headers))
        (unwind-protect
           (progn
             ,@forms)
-        (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
-        (gnus-inews-insert-draft-meta-information ,group ,article)
+        (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+                                     ,yanked)
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
@@ -387,18 +417,13 @@ Thank you for your help in stamping out bugs.
        (run-hooks 'post-command-hook)
        (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
-                          (if (listp article)
-                              (car article)
-                            article)) "\"\"")
-             ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group article)
+  (concat "(\"" group "\" "
+         (if article (number-to-string
+                      (if (listp article)
+                          (car article)
+                        article)) "\"\"")
+         ")"))
 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue
@@ -461,7 +486,8 @@ Gcc: header for archiving purposes."
                         (symbol-value (car elem))))
            (throw 'found (cons (cadr elem) (caddr elem)))))))))
 
-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+                                           &optional config yanked)
   (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)
@@ -480,8 +506,8 @@ Gcc: header for archiving purposes."
        (set-buffer ,buffer)
        ,(when article
           (if (eq config 'forward)
-              `(gnus-summary-mark-article-as-forwarded ',article)
-            `(gnus-summary-mark-article-as-replied ',article)))))
+              `(gnus-summary-mark-article-as-forwarded ',yanked)
+            `(gnus-summary-mark-article-as-replied ',yanked)))))
    'send))
 
 (put 'gnus-setup-message 'lisp-indent-function 1)
@@ -705,8 +731,7 @@ yanked."
             (with-current-buffer gnus-article-copy
               (save-restriction
                 (nnheader-narrow-to-headers)
-                (ietf-drums-unfold-fws)
-                (nnheader-parse-head t)))))
+                (nnheader-parse-naked-head)))))
        (message-yank-original)
        (setq beg (or beg (mark t))))
       (when articles
@@ -799,12 +824,14 @@ header line with the old Message-ID."
            (goto-char (point-min))
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))
-           (setq beg (point)
-                 end (or (message-goto-body) beg))
+           (let ((mail-header-separator ""))
+             (setq beg (point)
+                   end (or (message-goto-body) beg)))
            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)
-           (delete-region (goto-char (point-min))
-                          (or (message-goto-body) (point-max)))
+           (let ((mail-header-separator ""))
+             (delete-region (goto-char (point-min))
+                            (or (message-goto-body) (point-max))))
            ;; Insert the original article headers.
            (insert-buffer-substring gnus-original-article-buffer beg end)
            ;; Decode charsets.
@@ -819,6 +846,7 @@ header line with the old Message-ID."
   (when article-buffer
     (gnus-copy-article-buffer))
   (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+       (gnus-article-yanked-articles yank)
        (add-to-list gnus-add-to-list))
     (gnus-setup-message (cond (yank 'reply-yank)
                              (article-buffer 'reply)
@@ -877,7 +905,7 @@ header line with the old Message-ID."
          (gnus-inews-yank-articles yank))))))
 
 (defun gnus-msg-treat-broken-reply-to (&optional force)
-  "Remove the Reply-to header iff broken-reply-to."
+  "Remove the Reply-to header if broken-reply-to."
   (when (or force
            (gnus-group-find-parameter
             gnus-newsgroup-name 'broken-reply-to))
@@ -1018,6 +1046,7 @@ If VERY-WIDE, make a very wide reply."
                (caar yank)
              (car yank)))
           (gnus-article-reply (or article (gnus-summary-article-number)))
+          (gnus-article-yanked-articles yank)
           (headers ""))
       ;; Stripping headers should be specified with mail-yank-ignored-headers.
       (when yank
@@ -1055,13 +1084,13 @@ If VERY-WIDE, make a very wide reply."
        (set-buffer gnus-article-buffer)
        (setq signed (memq 'signed gnus-article-wash-types))
        (setq encrypted (memq 'encrypted gnus-article-wash-types)))
-      (cond ((and gnus-message-replysign signed)
-            (mml-secure-message mml-default-sign-method 'sign))
-           ((and gnus-message-replyencrypt encrypted)
+      (cond ((and gnus-message-replyencrypt encrypted)
             (mml-secure-message mml-default-encrypt-method
                                 (if gnus-message-replysignencrypted
                                     'signencrypt
-                                  'encrypt)))))))
+                                  'encrypt)))
+           ((and gnus-message-replysign signed)
+            (mml-secure-message mml-default-sign-method 'sign))))))
 
 (defun gnus-summary-reply-with-original (n &optional wide)
   "Start composing a reply mail to the current message.
@@ -1131,37 +1160,41 @@ If POST, post instead of mail.
 For the `inline' alternatives, also see the variable
 `message-forward-ignored-headers'."
   (interactive "P")
-  (if (null (cdr (gnus-summary-work-articles nil)))
-      (let ((message-forward-as-mime message-forward-as-mime)
-           (message-forward-show-mml message-forward-show-mml))
-       (cond
-        ((null arg))
-        ((eq arg 1)
-         (setq message-forward-as-mime nil
-               message-forward-show-mml t))
-        ((eq arg 2)
-         (setq message-forward-as-mime t
-               message-forward-show-mml nil))
-        ((eq arg 3)
-         (setq message-forward-as-mime t
-               message-forward-show-mml t))
-        ((eq arg 4)
-         (setq message-forward-as-mime nil
-               message-forward-show-mml nil))
-        (t
-         (setq message-forward-as-mime (not message-forward-as-mime))))
-       (let ((gnus-article-reply (gnus-summary-article-number)))
-         (gnus-setup-message 'forward
-           (gnus-summary-select-article)
-           (let ((mail-parse-charset
-                  (or (and (gnus-buffer-live-p gnus-article-buffer)
-                           (with-current-buffer gnus-article-buffer
-                             gnus-article-charset))
-                      gnus-newsgroup-charset))
-                 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
-             (set-buffer gnus-original-article-buffer)
-             (message-forward post)))))
-    (gnus-uu-digest-mail-forward arg post)))
+  (if (cdr (gnus-summary-work-articles nil))
+      ;; Process marks are given.
+      (gnus-uu-digest-mail-forward arg post)
+    ;; No process marks.
+    (let ((message-forward-as-mime message-forward-as-mime)
+         (message-forward-show-mml message-forward-show-mml))
+      (cond
+       ((null arg))
+       ((eq arg 1)
+       (setq message-forward-as-mime nil
+             message-forward-show-mml t))
+       ((eq arg 2)
+       (setq message-forward-as-mime t
+             message-forward-show-mml nil))
+       ((eq arg 3)
+       (setq message-forward-as-mime t
+             message-forward-show-mml t))
+       ((eq arg 4)
+       (setq message-forward-as-mime nil
+             message-forward-show-mml nil))
+       (t
+       (setq message-forward-as-mime (not message-forward-as-mime))))
+      (let* ((gnus-article-reply (gnus-summary-article-number))
+            (gnus-article-yanked-articles (list gnus-article-reply)))
+       (gnus-setup-message 'forward
+         (gnus-summary-select-article)
+         (let ((mail-parse-charset
+                (or (and (gnus-buffer-live-p gnus-article-buffer)
+                         (with-current-buffer gnus-article-buffer
+                           gnus-article-charset))
+                    gnus-newsgroup-charset))
+               (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."
@@ -1332,7 +1365,9 @@ The current group name will be inserted at \"%s\".")
               message-required-news-headers
             message-required-mail-headers)))
        (goto-char (point-max))
-       (insert "Gcc: " group "\n")
+       (if (string-match " " group)
+           (insert "Gcc: \"" group "\"\n")
+         (insert "Gcc: " group "\n"))
        (widen)))
     (gnus-inews-do-gcc)
     (when (and (get-buffer gnus-group-buffer)
@@ -1596,8 +1631,15 @@ this is a reply."
                    group))))
        (when gcc
          (insert "Gcc: "
-                 (if (stringp gcc) gcc
-                   (mapconcat 'identity gcc " "))
+                 (if (stringp gcc)
+                     (if (string-match " " gcc)
+                         (concat "\"" gcc "\"")
+                       gcc)
+                   (mapconcat (lambda (group)
+                                (if (string-match " " group)
+                                    (concat "\"" group "\"")
+                                  group))
+                              gcc " "))
                  "\n"))))))
 
 (defun gnus-inews-insert-archive-gcc (&optional group)
@@ -1658,8 +1700,12 @@ this is a reply."
              (progn
                (insert
                 (if (stringp gcc-self-val)
-                    gcc-self-val
-                  group))
+                    (if (string-match " " gcc-self-val)
+                        (concat "\"" gcc-self-val "\"")
+                      gcc-self-val)
+                  (if (string-match " " group)
+                      (concat "\"" group "\"")
+                    group)))
                (if (not (eq gcc-self-val 'none))
                    (insert "\n")
                  (progn
@@ -1667,10 +1713,13 @@ this is a reply."
                    (kill-line))))
            ;; Use the list of groups.
            (while (setq name (pop groups))
-             (insert (if (string-match ":" name)
-                         name
-                       (gnus-group-prefixed-name
-                        name gnus-message-archive-method)))
+             (let ((str (if (string-match ":" name)
+                            name
+                          (gnus-group-prefixed-name
+                           name gnus-message-archive-method))))
+               (insert (if (string-match " " str)
+                           (concat "\"" str "\"")
+                         str)))
              (when groups
                (insert " ")))
            (insert "\n")))))))
@@ -1778,6 +1827,8 @@ this is a reply."
       (setq results (delq name (delq address results)))
       ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
       (make-local-hook 'message-setup-hook)
+      (setq results (sort results (lambda (x y)
+                                   (string-lessp (car x) (car y)))))
       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond