(message-references-generator): New variable.

(message-generate-filled-references): New function.
(message-generate-folded-references): New function.
(message-generate-unfolded-references): New function.
(message-reply): Refer `message-references-generator'.
(message-followup): Refer `message-references-generator'.

diff --git a/lisp/message.el b/lisp/message.el
index 1151192..b893cdb 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -165,6 +165,17 @@ Otherwise, most addresses look like `angles', but they look like
                 (const default))
   :group 'message-headers)
 
+(defcustom message-references-generator
+  (if (fboundp 'std11-fill-msg-id-list-string)
+      (function message-generate-filled-references)
+    (function message-generate-folded-references))
+  "*Function to generate \"References\" field."
+  :type '(radio (function-item message-generate-filled-references)
+               (function-item message-generate-folded-references)
+               (function-item message-generate-unfolded-references)
+               (function :tag "Other"))
+  :group 'message-headers)
+
 (defcustom message-syntax-checks nil
   ;; Guess this one shouldn't be easy to customize...
   "Controls what syntax checks should not be performed on outgoing posts.
@@ -2923,6 +2934,44 @@ give as trustworthy answer as possible."
   (or mail-host-address
       (message-make-fqdn)))
 
+(defun message-generate-filled-references (references message-id)
+  "Return filled References field from REFERENCES MESSAGE-ID."
+  (std11-fill-msg-id-list-string (concat references message-id)))
+
+(defun message-generate-folded-references (references message-id)
+  "Return folded References field from REFERENCES MESSAGE-ID."
+  (if references
+      (let (quote)
+       (setq references
+             (mapconcat (function
+                         (lambda (char)
+                           (cond ((eq char ?\\)
+                                  (setq quote t)
+                                  "\\")
+                                 ((memq char '(?\  ?\t))
+                                  (prog1
+                                      (if quote
+                                          (char-to-string char)
+                                        (concat "\n" (char-to-string char)))
+                                    (setq quote nil)))
+                                 (t
+                                  (setq quote nil)
+                                  (char-to-string char)
+                                  ))))
+                        references ""))
+       (if message-id
+           (concat references "\n " message-id)
+         references))
+    message-id))
+
+(defun message-generate-unfolded-references (references message-id)
+  "Return folded References field from REFERENCES MESSAGE-ID."
+  (if references
+      (if message-id
+         (concat references " " message-id)
+       references)
+    message-id))
+
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."
@@ -3404,8 +3453,8 @@ Headers already prepared in the buffer are not modified."
      `((Subject . ,subject)
        ,@follow-to
        ,@(if (or references message-id)
-            `((References . ,(std11-fill-msg-id-list-string
-                              (concat references message-id)))))
+            `((References . ,(funcall message-references-generator
+                                      references message-id))))
        )
      cur)))
 
@@ -3512,8 +3561,8 @@ responses here are directed to other newsgroups."))
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))
        ,@(if (or references message-id)
-            `((References . ,(std11-fill-msg-id-list-string
-                              (concat references message-id)))))
+            `((References . ,(funcall message-references-generator
+                                      references message-id))))
        ,@(when (and mct
                    (not (equal (downcase mct) "never")))
           (list (cons 'Cc (if (equal (downcase mct) "always")