Importing gnus-5.6.22
[elisp/gnus.git-] / lisp / message.el
index e64ad70..2bedcf9 100644 (file)
@@ -241,7 +241,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."
@@ -915,7 +915,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
-    (References . message-fill-header)
+    (References . message-shorten-references)
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
@@ -1050,7 +1050,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)
@@ -1229,7 +1229,8 @@ Return the number of headers removed."
    ["Spellcheck" ispell-message t]
    "----"
    ["Send Message" message-send-and-exit t]
-   ["Abort Message" message-dont-send t]))
+   ["Abort Message" message-dont-send t]
+   ["Kill Message" message-kill-buffer t]))
 
 (easy-menu-define
  message-mode-field-menu message-mode-map ""
@@ -1302,19 +1303,18 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
        facemenu-remove-face-function t)
   (make-local-variable 'paragraph-separate)
   (make-local-variable 'paragraph-start)
+  ;; `-- ' precedes the signature.  `-----' appears at the start of the
+  ;; lines that delimit forwarded messages.
+  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
+  ;; are also sometimes used and should be separators.
   (setq paragraph-start
        (concat (regexp-quote mail-header-separator)
-               "$\\|[ \t]*[-_][-_][-_]+$\\|"
-               "-- $\\|"
+               "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
+               "-- $\\|---+$\\|"
+               page-delimiter
                ;;!!! Uhm... shurely this can't be right?
-               "[> " (regexp-quote message-yank-prefix) "]+$\\|"
-               paragraph-start))
-  (setq paragraph-separate
-       (concat (regexp-quote mail-header-separator)
-               "$\\|[ \t]*[-_][-_][-_]+$\\|"
-               "-- $\\|"
-               "[> " (regexp-quote message-yank-prefix) "]+$\\|"
-               paragraph-separate))
+               "[> " (regexp-quote message-yank-prefix) "]+$"))
+  (setq paragraph-separate paragraph-start)
   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)
@@ -1334,7 +1334,7 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (when (eq message-mail-alias-type 'abbrev)
     (if (fboundp 'mail-abbrevs-setup)
        (mail-abbrevs-setup)
-      (funcall (intern "mail-aliases-setup"))))
+      (mail-aliases-setup)))
   (message-set-auto-save-file-name)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
@@ -1720,7 +1720,7 @@ prefix, and don't delete any headers."
       (unless (bolp)
        (insert ?\n))
       (unless modified
-       (setq message-checksum (cons (message-checksum) (buffer-size)))))))
+       (setq message-checksum (message-checksum))))))
 
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
@@ -2438,8 +2438,7 @@ to find out how to use this."
    (message-check 'new-text
      (or
       (not message-checksum)
-      (not (and (eq (message-checksum) (car message-checksum))
-               (eq (buffer-size) (cdr message-checksum))))
+      (not (eq (message-checksum) message-checksum))
       (y-or-n-p
        "It looks like no new text has been added.  Really post? ")))
    ;; Check the length of the signature.
@@ -2999,6 +2998,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)
@@ -3186,7 +3203,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))
@@ -3213,7 +3230,7 @@ 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
@@ -3293,10 +3310,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)
@@ -3655,7 +3672,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)
@@ -3667,7 +3685,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)
@@ -3679,8 +3698,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)
@@ -3692,8 +3712,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