Add "Changing Servers".
[elisp/gnus.git-] / lisp / message.el
index cd9b577..63cdc3e 100644 (file)
   :type 'integer)
 
 (defcustom message-send-rename-function nil
-  "*Function called to rename the buffer after sending it."
+  "Function called to rename the buffer after sending it."
   :group 'message-buffers
   :type 'function)
 
@@ -165,19 +165,8 @@ 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...
+  ; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
@@ -214,7 +203,7 @@ included.  Organization, Lines and X-Mailer are optional."
   :type '(repeat sexp))
 
 (defcustom message-deletable-headers '(Message-ID Date Lines)
-  "*Headers to be deleted if they already exist and were generated by message previously."
+  "Headers to be deleted if they already exist and were generated by message previously."
   :group 'message-headers
   :type 'sexp)
 
@@ -231,7 +220,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:"
   "*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."
@@ -240,15 +229,17 @@ any confusion."
 
 ;;;###autoload
 (defcustom message-signature-separator "^-- *$"
-  "*Regexp matching the signature separator."
+  "Regexp matching the signature separator."
   :type 'regexp
   :group 'message-various)
 
 (defcustom message-elide-elipsis "\n[...]\n\n"
-  "*The string which is inserted for elided text.")
+  "*The string which is inserted for elided text."
+  :type 'string
+  :group 'message-various)
 
 (defcustom message-interactive nil
-  "*Non-nil means when sending a message wait for and display errors.
+  "Non-nil means when sending a message wait for and display errors.
 nil means let mailer mail back a message to report errors."
   :group 'message-sending
   :group 'message-mail
@@ -329,14 +320,14 @@ If nil, Message won't autosave."
   :type 'regexp)
 
 (defcustom message-cancel-message "I am canceling my own article."
-  "*Message to be inserted in the cancel message."
+  "Message to be inserted in the cancel message."
   :group 'message-interface
   :type 'string)
 
 ;; Useful to set in site-init.el
 ;;;###autoload
 (defcustom message-send-mail-function 'message-send-mail-with-sendmail
-  "*Function to call to send the current buffer as mail.
+  "Function to call to send the current buffer as mail.
 The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'.
 
@@ -353,7 +344,7 @@ Legal values include `message-send-mail-with-sendmail' (the default),
 
 ;; 1997-09-29 by MORIOKA Tomohiko
 (defcustom message-send-news-function 'message-send-news-with-gnus
-  "*Function to call to send the current buffer as news.
+  "Function to call to send the current buffer as news.
 The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'."
   :group 'message-sending
@@ -361,21 +352,21 @@ variable `mail-header-separator'."
   :type 'function)
 
 (defcustom message-reply-to-function nil
-  "*Function that should return a list of headers.
+  "Function that should return a list of headers.
 This function should pick out addresses from the To, Cc, and From headers
 and respond with new To and Cc headers."
   :group 'message-interface
   :type 'function)
 
 (defcustom message-wide-reply-to-function nil
-  "*Function that should return a list of headers.
+  "Function that should return a list of headers.
 This function should pick out addresses from the To, Cc, and From headers
 and respond with new To and Cc headers."
   :group 'message-interface
   :type 'function)
 
 (defcustom message-followup-to-function nil
-  "*Function that should return a list of headers.
+  "Function that should return a list of headers.
 This function should pick out addresses from the To, Cc, and From headers
 and respond with new To and Cc headers."
   :group 'message-interface
@@ -401,12 +392,12 @@ command line, because it is even more evil than leaving it out."
 
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
-  "*Location of the qmail-inject program."
+  "Location of the qmail-inject program."
   :group 'message-sending
   :type 'file)
 
 (defcustom message-qmail-inject-args nil
-  "*Arguments passed to qmail-inject programs.
+  "Arguments passed to qmail-inject programs.
 This should be a list of strings, one string for each argument.
 
 For e.g., if you wish to set the envelope sender address so that bounces
@@ -438,31 +429,30 @@ might set this variable to '(\"-f\" \"you@some.where\")."
 
 (defcustom message-setup-hook
   '(message-maybe-setup-default-charset turn-on-mime-edit)
-  "*Normal hook, run each time a new outgoing message is initialized.
+  "Normal hook, run each time a new outgoing message is initialized.
 The function `message-setup' runs this hook."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-signature-setup-hook nil
-  "*Normal hook, run each time a new outgoing message is initialized.
+  "Normal hook, run each time a new outgoing message is initialized.
 It is run after the headers have been inserted and before
 the signature is inserted."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-mode-hook nil
-  "*Hook run in message mode buffers."
+  "Hook run in message mode buffers."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-header-hook '(eword-encode-header)
-  "*Hook run in a message mode buffer narrowed to the headers."
+  "Hook run in a message mode buffer narrowed to the headers."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-header-setup-hook nil
-  "*Hook called narrowed to the headers when setting up a message
-buffer."
+  "Hook called narrowed to the headers when setting up a message buffer."
   :group 'message-various
   :type 'hook)
 
@@ -533,14 +523,14 @@ If a form, the result from the form will be used instead."
   :type 'function)
 
 (defcustom message-expires 14
-  "*Number of days before your article expires."
+  "Number of days before your article expires."
   :group 'message-news
   :group 'message-headers
   :link '(custom-manual "(message)News Headers")
   :type 'integer)
 
 (defcustom message-user-path nil
-  "*If nil, use the NNTP server name in the Path header.
+  "If nil, use the NNTP server name in the Path header.
 If stringp, use this; if non-nil, use no host name (user name only)."
   :group 'message-news
   :group 'message-headers
@@ -566,6 +556,7 @@ If stringp, use this; if non-nil, use no host name (user name only)."
 
 (define-widget 'message-header-lines 'text
   "All header lines must be LFD terminated."
+  :format "%t:%n%v"
   :valid-regexp "^\\'"
   :error "All header lines must be newline terminated")
 
@@ -816,23 +807,23 @@ Defaults to `text-mode-abbrev-table'.")
 The cdr of ech entry is a function for applying the face to a region.")
 
 (defcustom message-send-hook nil
-  "*Hook run before sending messages."
+  "Hook run before sending messages."
   :group 'message-various
   :options '(ispell-message)
   :type 'hook)
 
 (defcustom message-send-mail-hook nil
-  "*Hook run before sending mail messages."
+  "Hook run before sending mail messages."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-send-news-hook nil
-  "*Hook run before sending news messages."
+  "Hook run before sending news messages."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-sent-hook nil
-  "*Hook run after sending messages."
+  "Hook run after sending messages."
   :group 'message-various
   :type 'hook)
 
@@ -926,7 +917,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-fill-references)
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
@@ -941,7 +932,10 @@ The cdr of ech entry is a function for applying the face to a region.")
   (autoload 'gnus-output-to-rmail "gnus-util")
   (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
   (autoload 'nndraft-request-associate-buffer "nndraft")
-  (autoload 'nndraft-request-expire-articles "nndraft"))
+  (autoload 'nndraft-request-expire-articles "nndraft")
+  (autoload 'gnus-open-server "gnus-int")
+  (autoload 'gnus-request-post "gnus-int")
+  (autoload 'rmail-output "rmail"))
 
 \f
 
@@ -1276,6 +1270,7 @@ C-c C-w  message-insert-signature (insert `message-signature-file' file).
 C-c C-y  message-yank-original (insert current message, if any).
 C-c C-q  message-fill-yanked-message (fill what was yanked).
 C-c C-e  message-elide-region (elide the text between point and mark).
+C-c C-z  message-kill-to-signature (kill the text up to the signature).
 C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (interactive)
   (kill-all-local-variables)
@@ -1339,10 +1334,10 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
        (mail-abbrevs-setup)
       (funcall (intern "mail-aliases-setup"))))
   (message-set-auto-save-file-name)
-  (gnus-run-hooks 'text-mode-hook 'message-mode-hook)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
-        '(message-font-lock-keywords t))))
+        '(message-font-lock-keywords t)))
+  (run-hooks 'text-mode-hook 'message-mode-hook))
 
 \f
 
@@ -1476,7 +1471,8 @@ With the prefix argument FORCE, insert the header anyway."
   (interactive)
   (let ((point (point)))
     (message-goto-signature)
-    (forward-line -2)
+    (unless (eobp)
+      (forward-line -2))
     (kill-region point (point))
     (unless (bolp)
       (insert "\n"))))
@@ -1535,8 +1531,9 @@ With the prefix argument FORCE, insert the header anyway."
       (or (bolp) (insert "\n")))))
 
 (defun message-elide-region (b e)
-  "Elide the text between point and mark.  An ellipsis (from
-message-elide-elipsis) will be inserted where the text was killed."
+  "Elide the text between point and mark.
+An ellipsis (from `message-elide-elipsis') will be inserted where the
+text was killed."
   (interactive "r")
   (kill-region b e)
   (unless (bolp)
@@ -1832,6 +1829,7 @@ The text will also be indented the normal way."
 (defun message-dont-send ()
   "Don't send the message you have been editing."
   (interactive)
+  (set-buffer-modified-p t)
   (save-buffer)
   (let ((actions message-postpone-actions))
     (message-bury (current-buffer))
@@ -1873,7 +1871,7 @@ the user from the mailer."
     (let ((inhibit-read-only t))
       (put-text-property (point-min) (point-max) 'read-only nil))
     (message-fix-before-sending)
-    (gnus-run-hooks 'message-send-hook)
+    (run-hooks 'message-send-hook)
     (message "Sending...")
     (let ((message-encoding-buffer
           (message-generate-new-buffer-clone-locals " message encoding"))
@@ -1902,7 +1900,7 @@ the user from the mailer."
        (message-do-fcc)
        ;;(when (fboundp 'mail-hist-put-headers-into-history)
        ;; (mail-hist-put-headers-into-history))
-       (gnus-run-hooks 'message-sent-hook)
+       (run-hooks 'message-sent-hook)
        (message "Sending...done")
        ;; Mark the buffer as unmodified and delete autosave.
        (set-buffer-modified-p nil)
@@ -1962,7 +1960,7 @@ the user from the mailer."
             (if news nil message-deletable-headers)))
        (message-generate-headers message-required-mail-headers))
       ;; Let the user do all of the above.
-      (gnus-run-hooks 'message-header-hook))
+      (run-hooks 'message-header-hook))
     (unwind-protect
        (save-excursion
          (set-buffer tembuf)
@@ -2009,7 +2007,7 @@ the user from the mailer."
       (replace-match "\n")
       (backward-char 1)
       (setq delimline (point-marker))
-      (gnus-run-hooks 'message-send-mail-hook)
+      (run-hooks 'message-send-mail-hook)
       ;; Insert an extra newline if we need it to work around
       ;; Sun's bug that swallows newlines.
       (goto-char (1+ delimline))
@@ -2065,7 +2063,7 @@ to find out how to use this."
   (re-search-forward
    (concat "^" (regexp-quote mail-header-separator) "\n"))
   (replace-match "\n")
-  (gnus-run-hooks 'message-send-mail-hook)
+  (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
       (let ((coding-system-for-write 'binary))
@@ -2112,7 +2110,7 @@ to find out how to use this."
                (concat "^" (symbol-name (car headers)) ": *") nil t)
               (message-delete-line))
          (pop headers))))
-    (gnus-run-hooks 'message-send-mail-hook)
+    (run-hooks 'message-send-mail-hook)
     ;; Pass it on to mh.
     (mh-send-letter)))
 
@@ -2272,7 +2270,7 @@ to find out how to use this."
       ;; Insert some headers.
       (message-generate-headers message-required-news-headers)
       ;; Let the user do all of the above.
-      (gnus-run-hooks 'message-header-hook))
+      (run-hooks 'message-header-hook))
     (message-cleanup-headers)
     (if (not (message-check-news-syntax))
        (progn
@@ -2452,8 +2450,12 @@ to find out how to use this."
      (let* ((case-fold-search t)
            (message-id (message-fetch-field "message-id" t)))
        (or (not message-id)
+          ;; Is there an @ in the ID?
           (and (string-match "@" message-id)
-               (string-match "@[^\\.]*\\." message-id))
+               ;; Is there a dot in the ID?
+               (string-match "@[^.]*\\." message-id)
+               ;; Does the ID end with a dot?
+               (not (string-match "\\.>" message-id)))
           (y-or-n-p
            (format "The Message-ID looks strange: \"%s\".  Really post? "
                    message-id)))))
@@ -2639,7 +2641,7 @@ to find out how to use this."
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))
-      (gnus-run-hooks 'message-header-hook 'message-before-do-fcc-hook)
+      (run-hooks 'message-header-hook 'message-before-do-fcc-hook)
       (goto-char (point-min))
       (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
       (replace-match "" t t)
@@ -2955,44 +2957,6 @@ 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 and 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 and 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 and 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."
@@ -3116,7 +3080,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 ()
@@ -3170,6 +3134,13 @@ Headers already prepared in the buffer are not modified."
     (widen)
     (forward-line 1)))
 
+(defun message-fill-references (header value)
+  (insert (capitalize (symbol-name header))
+         ": "
+         (std11-fill-msg-id-list-string
+          (if (consp value) (car value) value))
+         "\n"))
+
 (defun message-fill-header (header value)
   (let ((begin (point))
        (fill-column 990)
@@ -3321,14 +3292,14 @@ Headers already prepared in the buffer are not modified."
        (delq 'Lines
             (delq 'Subject
                   (copy-sequence message-required-mail-headers))))))
-  (gnus-run-hooks 'message-signature-setup-hook)
+  (run-hooks 'message-signature-setup-hook)
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)
-    (gnus-run-hooks 'message-header-setup-hook))
+    (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
-  (gnus-run-hooks 'message-setup-hook)
+  (run-hooks 'message-setup-hook)
   (message-position-point)
   (undo-boundary))
 
@@ -3474,9 +3445,9 @@ Headers already prepared in the buffer are not modified."
      `((Subject . ,subject)
        ,@follow-to
        ,@(if (or references message-id)
-            `((References . ,(funcall message-references-generator
-                                      references message-id))))
-       )
+            `((References . ,(concat (or references "") (and references " ")
+                                     (or message-id ""))))
+          nil))
      cur)))
 
 ;;;###autoload
@@ -3582,8 +3553,8 @@ responses here are directed to other newsgroups."))
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))
        ,@(if (or references message-id)
-            `((References . ,(funcall message-references-generator
-                                      references message-id))))
+            `((References . ,(concat (or references "") (and references " ")
+                                     (or message-id "")))))
        ,@(when (and mct
                    (not (equal (downcase mct) "never")))
           (list (cons 'Cc (if (equal (downcase mct) "always")
@@ -3603,18 +3574,20 @@ responses here are directed to other newsgroups."))
   (unless (message-news-p)
     (error "This is not a news article; canceling is impossible"))
   (when (yes-or-no-p "Do you really want to cancel this article? ")
-    (let (from newsgroups message-id distribution buf)
+    (let (from newsgroups message-id distribution buf sender)
       (save-excursion
        ;; Get header info. from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
+               sender (message-fetch-field "sender")
                newsgroups (message-fetch-field "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 (cadr (std11-extract-address-components from)))
+                (downcase
+                 (or sender (cadr (std11-extract-address-components from))))
                 (downcase (message-make-address)))
          (error "This article is not yours"))
        ;; Make control message.
@@ -3773,7 +3746,7 @@ Optional NEWS will use news to forward instead of mail."
        (goto-char (point-max)))
       (insert mail-header-separator)
       ;; Rename all old ("Also-")Resent headers.
-      (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+      (while (re-search-backward "^\\(Also-\\)*Resent-" beg t)
        (beginning-of-line)
        (insert "Also-"))
       ;; Quote any "From " lines at the beginning.