sync up with MainBranch .. gnus-6_7_3
[elisp/gnus.git-] / lisp / message.el
index d116370..2b63157 100644 (file)
@@ -1,7 +1,7 @@
 ;;; message.el --- composing mail and news messages
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: mail, news, MIME
 
@@ -227,6 +227,11 @@ any confusion."
   :group 'message-interface
   :type 'regexp)
 
+(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
+  "*Regexp matching \"Re: \" in the subject line."
+  :group 'message-various
+  :type 'regexp)
+
 ;;;###autoload
 (defcustom message-signature-separator "^-- *$"
   "Regexp matching the signature separator."
@@ -246,7 +251,7 @@ nil means let mailer mail back a message to report errors."
   :type 'boolean)
 
 (defcustom message-generate-new-buffers t
-  "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+  "*Non-nil means that a new message buffer will be created whenever `message-setup' is called.
 If this is a function, call that function with three parameters:  The type,
 the to address and the group name.  (Any of these may be nil.)  The function
 should return the new buffer name."
@@ -922,7 +927,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
-    (References . message-fill-references)
+    (References . message-shorten-references)
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
@@ -1047,7 +1052,7 @@ The cdr of ech entry is a function for applying the face to a region.")
 
 (defun message-strip-subject-re (subject)
   "Remove \"Re:\" from subject lines."
-  (if (string-match "^[Rr][Ee]: *" subject)
+  (if (string-match message-subject-re-regexp subject)
       (substring subject (match-end 0))
     subject))
 
@@ -1057,7 +1062,7 @@ If REGEXP, HEADER is a regular expression.
 If FIRST, only remove the first instance of the header.
 Return the number of headers removed."
   (goto-char (point-min))
-  (let ((regexp (if is-regexp header (concat "^" header ":")))
+  (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
        (number 0)
        (case-fold-search t)
        last)
@@ -1927,7 +1932,7 @@ the user from the mailer."
        t))))
 
 (defun message-send-via-mail (arg)
-  "Send the current message via mail."  
+  "Send the current message via mail."
   (message-send-mail arg))
 
 (defun message-send-via-news (arg)
@@ -3096,7 +3101,7 @@ Headers already prepared in the buffer are not modified."
            (insert "Original-")
            (beginning-of-line))
          (when (or (message-news-p)
-                   (string-match "^[^@]+@.+\\..+" secure-sender))
+                   (string-match "@.+\\.." secure-sender))
            (insert "Sender: " secure-sender "\n")))))))
 
 (defun message-insert-courtesy-copy ()
@@ -3178,6 +3183,24 @@ Headers already prepared in the buffer are not modified."
        (replace-match " " t t))
       (goto-char (point-max)))))
 
+(defun message-shorten-references (header references)
+  "Limit REFERENCES to be shorter than 988 characters."
+  (let ((max 988)
+       (cut 4)
+       refs)
+    (nnheader-temp-write nil
+      (insert references)
+      (goto-char (point-min))
+      (while (re-search-forward "<[^>]+>" nil t)
+       (push (match-string 0) refs))
+      (setq refs (nreverse refs))
+      (while (> (length (mapconcat 'identity refs " ")) max)
+       (when (< (length refs) (1+ cut))
+         (decf cut))
+       (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
+    (insert (capitalize (symbol-name header)) ": "
+           (mapconcat 'identity refs " ") "\n")))
+
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
   (message-narrow-to-headers)
@@ -3365,7 +3388,7 @@ Headers already prepared in the buffer are not modified."
                     (Subject . ,(or subject ""))))))
 
 ;;;###autoload
-(defun message-reply (&optional to-address wide ignore-reply-to)
+(defun message-reply (&optional to-address wide)
   "Start editing a reply to the article in the current buffer."
   (interactive)
   (let ((cur (current-buffer))
@@ -3392,12 +3415,12 @@ Headers already prepared in the buffer are not modified."
            to (message-fetch-field "to")
            cc (message-fetch-field "cc")
            mct (message-fetch-field "mail-copies-to")
-           reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
+           reply-to (message-fetch-field "reply-to")
            references (message-fetch-field "references")
            message-id (message-fetch-field "message-id" t))
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.
-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+      (when (string-match message-subject-re-regexp subject)
        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
 
@@ -3472,10 +3495,10 @@ Headers already prepared in the buffer are not modified."
      cur)))
 
 ;;;###autoload
-(defun message-wide-reply (&optional to-address ignore-reply-to)
+(defun message-wide-reply (&optional to-address)
   "Make a \"wide\" reply to the message in the current buffer."
   (interactive)
-  (message-reply to-address t ignore-reply-to))
+  (message-reply to-address t))
 
 ;;;###autoload
 (defun message-followup (&optional to-newsgroups)
@@ -3518,7 +3541,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
        (setq distribution nil))
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.
-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+      (when (string-match message-subject-re-regexp subject)
        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
       (widen))
@@ -3606,10 +3629,14 @@ responses here are directed to other newsgroups."))
                message-id (message-fetch-field "message-id" t)
                distribution (message-fetch-field "distribution")))
        ;; Make sure that this article was written by the user.
-       (unless (string-equal
-                (downcase
-                 (or sender (cadr (std11-extract-address-components from))))
-                (downcase (message-make-address)))
+       (unless (or (and sender
+                        (string-equal
+                         (downcase sender)
+                         (downcase (message-make-sender))))
+                   (string-equal
+                    (downcase (cadr (mail-extract-address-components from)))
+                    (downcase (cadr (mail-extract-address-components
+                                     (message-make-from))))))
          (error "This article is not yours"))
        ;; Make control message.
        (setq buf (set-buffer (get-buffer-create " *message cancel*")))
@@ -3838,7 +3865,8 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))
-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+  (let ((message-this-is-mail t))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
 
 ;;;###autoload
 (defun message-mail-other-frame (&optional to subject)
@@ -3850,7 +3878,8 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))
-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+  (let ((message-this-is-mail t))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
 
 ;;;###autoload
 (defun message-news-other-window (&optional newsgroups subject)
@@ -3862,8 +3891,9 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
-  (message-setup `((Newsgroups . ,(or newsgroups ""))
-                  (Subject . ,(or subject "")))))
+  (let ((message-this-is-news t))
+    (message-setup `((Newsgroups . ,(or newsgroups ""))
+                    (Subject . ,(or subject ""))))))
 
 ;;;###autoload
 (defun message-news-other-frame (&optional newsgroups subject)
@@ -3875,8 +3905,9 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
-  (message-setup `((Newsgroups . ,(or newsgroups ""))
-                  (Subject . ,(or subject "")))))
+  (let ((message-this-is-news t))
+    (message-setup `((Newsgroups . ,(or newsgroups ""))
+                    (Subject . ,(or subject ""))))))
 
 ;;; underline.el