*** empty log message ***
[gnus] / lisp / message.el
index db77bcc..238a138 100644 (file)
@@ -210,7 +210,7 @@ included.  Organization, Lines and X-Mailer are optional."
   :group 'message-headers
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:"
   "*Header lines matching this regexp will be deleted before posting.
 It's best to delete old Path and Date headers before posting to avoid
 any confusion."
@@ -464,16 +464,12 @@ Used by `message-yank-original' via `message-yank-cite'."
   :type 'integer)
 
 ;;;###autoload
-(defcustom message-cite-function
-  (if (and (boundp 'mail-citation-hook)
-          mail-citation-hook)
-      mail-citation-hook
-    'message-cite-original)
+(defcustom message-cite-function 'message-cite-original
   "*Function for citing an original message.
-Pre-defined functions include `message-cite-original' and
-`message-cite-original-without-signature'."
+Predefined functions include `message-cite-original' and
+`message-cite-original-without-signature'.
+Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
-               (function-item message-cite-original-without-signature)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
@@ -1050,7 +1046,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 +1225,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 +1299,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 +1330,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)
@@ -1421,12 +1417,15 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (search-forward (concat "\n" mail-header-separator "\n") nil t))
 
 (defun message-goto-signature ()
-  "Move point to the beginning of the message signature."
+  "Move point to the beginning of the message signature.
+If there is no signature in the article, go to the end and
+return nil."
   (interactive)
   (goto-char (point-min))
   (if (re-search-forward message-signature-separator nil t)
       (forward-line 1)
-    (goto-char (point-max))))
+    (goto-char (point-max))
+    nil))
 
 \f
 
@@ -1466,16 +1465,17 @@ With the prefix argument FORCE, insert the header anyway."
   (interactive "r")
   (save-excursion
     (goto-char end)
-    (delete-region (point) (progn (message-goto-signature)
-                                 (forward-line -2)
-                                 (point)))
+    (delete-region (point) (if (not (message-goto-signature))
+                              (point)
+                            (forward-line -2)
+                            (point)))
     (insert "\n")
     (goto-char beg)
     (delete-region beg (progn (message-goto-body)
                              (forward-line 2)
                              (point))))
-  (message-goto-signature)
-  (forward-line -2))
+  (when (message-goto-signature)
+    (forward-line -2)))
 
 (defun message-kill-to-signature ()
   "Deletes all text up to the signature."
@@ -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."
@@ -1733,6 +1733,11 @@ prefix, and don't delete any headers."
             (list message-indent-citation-function)))))
     (goto-char end)
     (when (re-search-backward "^-- $" start t)
+      ;; Also peel off any blank lines before the signature.
+      (forward-line -1)
+      (while (looking-at "^[ \t]*$")
+       (forward-line -1))
+      (forward-line 1)
       (delete-region (point) end))
     (goto-char start)
     (while functions
@@ -1744,19 +1749,22 @@ prefix, and don't delete any headers."
 
 (defun message-cite-original ()
   "Cite function in the standard Message manner."
-  (let ((start (point))
-       (functions
-        (when message-indent-citation-function
-          (if (listp message-indent-citation-function)
-              message-indent-citation-function
-            (list message-indent-citation-function)))))
-    (goto-char start)
-    (while functions
-      (funcall (pop functions)))
-    (when message-citation-line-function
-      (unless (bolp)
-       (insert "\n"))
-      (funcall message-citation-line-function))))
+  (if (and (boundp 'mail-citation-hook)
+          mail-citation-hook)
+      (run-hooks 'mail-citation-hook)
+    (let ((start (point))
+         (functions
+          (when message-indent-citation-function
+            (if (listp message-indent-citation-function)
+                message-indent-citation-function
+              (list message-indent-citation-function)))))
+      (goto-char start)
+      (while functions
+       (funcall (pop functions)))
+      (when message-citation-line-function
+       (unless (bolp)
+         (insert "\n"))
+       (funcall message-citation-line-function)))))
 
 (defun message-insert-citation-line ()
   "Function that inserts a simple citation line."
@@ -2438,8 +2446,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.
@@ -2847,7 +2854,13 @@ Headers already prepared in the buffer are not modified."
              (setq header (car elem)))
          (setq header elem))
        (when (or (not (re-search-forward
-                       (concat "^" (downcase (symbol-name header)) ":")
+                       (concat "^"
+                               (regexp-quote
+                                (downcase
+                                 (if (stringp header)
+                                     header
+                                   (symbol-name header))))
+                               ":")
                        nil t))
                  (progn
                    ;; The header was found.  We insert a space after the
@@ -2889,7 +2902,8 @@ Headers already prepared in the buffer are not modified."
                  (progn
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
-                   (insert (symbol-name header) ": " value "\n")
+                   (insert (if (stringp header) header (symbol-name header))
+                           ": " value "\n")
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
@@ -3060,7 +3074,8 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
-  (let ((buffer (get-buffer name)))
+  (let ((buffer (get-buffer name))
+       (cur (current-buffer)))
     (if (and buffer
             (buffer-name buffer))
        (progn
@@ -3069,9 +3084,9 @@ Headers already prepared in the buffer are not modified."
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
-      (set-buffer (pop-to-buffer name))))
-  (erase-buffer)
-  (message-mode))
+      (set-buffer (pop-to-buffer name)))
+    (erase-buffer)
+    (message-mode)))
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
@@ -3204,7 +3219,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))
@@ -3231,7 +3246,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
@@ -3311,10 +3326,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)