gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi...

[bpt/emacs.git] / lisp / gnus / message.el

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 788cb3f..2e27dac 100644 (file)
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -249,6 +249,14 @@ included.  Organization and User-Agent are optional."
   :link '(custom-manual "(message)Message Headers")
   :type '(repeat sexp))
 
   :link '(custom-manual "(message)Message Headers")
   :type '(repeat sexp))
 

+(defcustom message-prune-recipient-rules nil
+  "Rules for how to prune the list of recipients when doing wide replies.
+This is a list of regexps and regexp matches."
+  :group 'message-mail
+  :group 'message-headers
+  :link '(custom-manual "(message)Wide Reply")
+  :type '(repeat regexp))
+

 (defcustom message-deletable-headers '(Message-ID Date Lines)
   "Headers to be deleted if they already exist and were generated by message previously."
   :group 'message-headers
 (defcustom message-deletable-headers '(Message-ID Date Lines)
   "Headers to be deleted if they already exist and were generated by message previously."
   :group 'message-headers


@@ -1620,11 +1628,11 @@ If you'd like to make it possible to share draft files between XEmacs
 and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
 Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
 
 and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
 Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
 

-(defcustom message-send-mail-partially-limit 1000000
+(defcustom message-send-mail-partially-limit nil

   "The limitation of messages sent as message/partial.
 The lower bound of message size in characters, beyond which the message
 should be sent in several parts.  If it is nil, the size is unlimited."
   "The limitation of messages sent as message/partial.
 The lower bound of message size in characters, beyond which the message
 should be sent in several parts.  If it is nil, the size is unlimited."

-  :version "21.1"
+  :version "24.1"

   :group 'message-buffers
   :link '(custom-manual "(message)Mail Variables")
   :type '(choice (const :tag "unlimited" nil)
   :group 'message-buffers
   :link '(custom-manual "(message)Mail Variables")
   :type '(choice (const :tag "unlimited" nil)


@@ -1739,6 +1747,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-mime-part nil)
 (defvar message-posting-charset nil)
 (defvar message-inserted-headers nil)
 (defvar message-mime-part nil)
 (defvar message-posting-charset nil)
 (defvar message-inserted-headers nil)

+(defvar message-inhibit-ecomplete nil)

 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)
 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)


@@ -4091,7 +4100,8 @@ It should typically alter the sending method in some way or other."
        (run-hooks 'message-sent-hook))
       (message "Sending...done")
       ;; Do ecomplete address snarfing.
        (run-hooks 'message-sent-hook))
       (message "Sending...done")
       ;; Do ecomplete address snarfing.

-      (when (message-mail-alias-type-p 'ecomplete)
+      (when (and (message-mail-alias-type-p 'ecomplete)
+                (not message-inhibit-ecomplete))

        (message-put-addresses-in-ecomplete))
       ;; Mark the buffer as unmodified and delete auto-save.
       (set-buffer-modified-p nil)
        (message-put-addresses-in-ecomplete))
       ;; Mark the buffer as unmodified and delete auto-save.
       (set-buffer-modified-p nil)


@@ -5431,7 +5441,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
           (* 25 25)))
   (let ((tm (current-time)))
     (concat
           (* 25 25)))
   (let ((tm (current-time)))
     (concat

-     (if (or (memq system-type '(ms-dos emx))
+     (if (or (eq system-type 'ms-dos)

             ;; message-number-base36 doesn't handle bigints.
             (floatp (user-uid)))
         (let ((user (downcase (user-login-name))))
             ;; message-number-base36 doesn't handle bigints.
             (floatp (user-uid)))
         (let ((user (downcase (user-login-name))))


@@ -6449,9 +6459,7 @@ are not included."
       (setq buffer-file-name (expand-file-name
                              (concat
                              (if (memq system-type
       (setq buffer-file-name (expand-file-name
                              (concat
                              (if (memq system-type

-                                       '(ms-dos ms-windows windows-nt
-                                                cygwin cygwin32 win32 w32
-                                                mswindows))
+                                       '(ms-dos windows-nt cygwin))

                                  "message"
                                "*message*")
                               (format-time-string "-%Y%m%d-%H%M%S"))
                                  "message"
                                "*message*")
                               (format-time-string "-%Y%m%d-%H%M%S"))


@@ -6551,7 +6559,7 @@ The function is called with one parameter, a cons cell ..."
 
 (defun message-get-reply-headers (wide &optional to-address address-headers)
   (let (follow-to mct never-mct to cc author mft recipients extra)
 
 (defun message-get-reply-headers (wide &optional to-address address-headers)
   (let (follow-to mct never-mct to cc author mft recipients extra)

-  ;; Find all relevant headers we need.
+    ;; Find all relevant headers we need.

     (save-restriction
       (message-narrow-to-headers-or-head)
       ;; Gmane renames "To".  Look at "Original-To", too, if it is present in
     (save-restriction
       (message-narrow-to-headers-or-head)
       ;; Gmane renames "To".  Look at "Original-To", too, if it is present in


@@ -6677,6 +6685,8 @@ want to get rid of this query permanently.")))
                (if recip
                    (setq recipients (delq recip recipients))))))))
 
                (if recip
                    (setq recipients (delq recip recipients))))))))
 

+      (setq recipients (message-prune-recipients recipients))
+      

       ;; Build the header alist.  Allow the user to be asked whether
       ;; or not to reply to all recipients in a wide reply.
       (setq follow-to (list (cons 'To (cdr (pop recipients)))))
       ;; Build the header alist.  Allow the user to be asked whether
       ;; or not to reply to all recipients in a wide reply.
       (setq follow-to (list (cons 'To (cdr (pop recipients)))))


@@ -6690,6 +6700,22 @@ want to get rid of this query permanently.")))
        (push (cons 'Cc recipients) follow-to)))
     follow-to))
 
        (push (cons 'Cc recipients) follow-to)))
     follow-to))
 

+(defun message-prune-recipients (recipients)
+  (dolist (rule message-prune-recipient-rules)
+    (let ((match (car rule))
+         dup-match 
+         address)
+      (dolist (recipient recipients)
+       (setq address (car recipient))
+       (when (string-match match address)
+         (setq dup-match (replace-match (cadr rule) nil nil address))
+         (dolist (recipient recipients)
+           ;; Don't delete the address that triggered this.
+           (when (and (not (eq address (car recipient)))
+                      (string-match dup-match (car recipient)))
+             (setq recipients (delq recipient recipients))))))))
+  recipients)
+

 (defcustom message-simplify-subject-functions
   '(message-strip-list-identifiers
     message-strip-subject-re
 (defcustom message-simplify-subject-functions
   '(message-strip-list-identifiers
     message-strip-subject-re


@@ -7162,27 +7188,27 @@ Optional DIGEST will use digest to forward."
   (insert
    "\n-------------------- Start of forwarded message --------------------\n")
   (let ((b (point))
   (insert
    "\n-------------------- Start of forwarded message --------------------\n")
   (let ((b (point))

-       contents multibyte-p e)
-    (with-current-buffer forward-buffer
-      (setq contents (buffer-string)
-           multibyte-p (mm-multibyte-p)))
-    (insert
-     (with-temp-buffer
-       (if multibyte-p
-          (progn
-            (mm-enable-multibyte)
-            (insert contents))
-        (mm-disable-multibyte)
-        (insert contents)
-        (mm-enable-multibyte))
-       (mime-to-mml)
-       (goto-char (point-min))
-       (when (looking-at "From ")
-        (replace-match "X-From-Line: "))
-       (buffer-string)))
+       (contents (with-current-buffer forward-buffer (buffer-string)))
+       e)
+    (unless (featurep 'xemacs)
+      (unless (mm-multibyte-string-p contents)
+       (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+              (if (bufferp forward-buffer)
+                  (buffer-name forward-buffer)
+                forward-buffer)
+              (buffer-name))))
+    (insert (mm-with-multibyte-buffer
+             (insert contents)
+             (mime-to-mml)
+             (goto-char (point-min))
+             (when (looking-at "From ")
+               (replace-match "X-From-Line: "))
+             (buffer-string)))
+    (unless (bolp) (insert "\n"))

     (setq e (point))
     (insert
     (setq e (point))
     (insert

-     "\n-------------------- End of forwarded message --------------------\n")
+     "-------------------- End of forwarded message --------------------\n")

     (message-remove-ignored-headers b e)))
 
 (defun message-remove-ignored-headers (b e)
     (message-remove-ignored-headers b e)))
 
 (defun message-remove-ignored-headers (b e)


@@ -7218,24 +7244,22 @@ Optional DIGEST will use digest to forward."
   (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
   (let ((b (point)) e)
     (if (not message-forward-decoded-p)
   (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
   (let ((b (point)) e)
     (if (not message-forward-decoded-p)

-       (let (contents multibyte-p)
-         (with-current-buffer forward-buffer
-           (setq contents (buffer-string)
-                 multibyte-p (mm-multibyte-p)))
-         (insert
-          (with-temp-buffer
-            (if multibyte-p
-                (progn
-                  (mm-enable-multibyte)
-                  (insert contents))
-              (mm-disable-multibyte)
-              (insert contents)
-              (mm-enable-multibyte))
-            (mime-to-mml)
-            (goto-char (point-min))
-            (when (looking-at "From ")
-              (replace-match "X-From-Line: "))
-            (buffer-string))))
+       (let ((contents (with-current-buffer forward-buffer (buffer-string))))
+         (unless (featurep 'xemacs)
+           (unless (mm-multibyte-string-p contents)
+             (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+                    (if (bufferp forward-buffer)
+                        (buffer-name forward-buffer)
+                      forward-buffer)
+                    (buffer-name))))
+         (insert (mm-with-multibyte-buffer
+                   (insert contents)
+                   (mime-to-mml)
+                   (goto-char (point-min))
+                   (when (looking-at "From ")
+                     (replace-match "X-From-Line: "))
+                   (buffer-string))))

       (save-restriction
        (narrow-to-region (point) (point))
        (mml-insert-buffer forward-buffer)
       (save-restriction
        (narrow-to-region (point) (point))
        (mml-insert-buffer forward-buffer)


@@ -7427,6 +7451,7 @@ is for the internal use."
        (replace-match "X-From-Line: "))
       ;; Send it.
       (let ((message-inhibit-body-encoding t)
        (replace-match "X-From-Line: "))
       ;; Send it.
       (let ((message-inhibit-body-encoding t)

+           (message-inhibit-ecomplete t)

            message-required-mail-headers
            message-generate-hashcash
            rfc2047-encode-encoded-words)
            message-required-mail-headers
            message-generate-hashcash
            rfc2047-encode-encoded-words)