(gnus-article-refer-article): Be more permissive.
[gnus] / lisp / message.el
index b53c6f1..a9faf5e 100644 (file)
@@ -1,5 +1,5 @@
 ;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -174,7 +174,7 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers
   :type 'boolean)
 
-(defcustom message-syntax-checks 
+(defcustom message-syntax-checks
   (if message-insert-canlock '((sender . disabled)) nil)
   ;; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
@@ -188,14 +188,28 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
 `new-text', `quoting-style', `redirected-followup', `signature',
 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 `subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+'continuation-headers', and `long-header-lines'."
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 
+(defcustom message-required-headers '((optional . References) From)
+  "*Headers to be generated or prompted for when sending a message.
+Also see `message-required-news-headers' and
+`message-required-mail-headers'."
+  :group 'message-news
+  :group 'message-headers
+  :type '(repeat sexp))
+
+(defcustom message-draft-headers '(References From)
+  "*Headers to be generated when saving a draft message."
+  :group 'message-news
+  :group 'message-headers
+  :type '(repeat sexp))
+
 (defcustom message-required-news-headers
   '(From Newsgroups Subject Date Message-ID
         (optional . Organization)
-        (optional . References)
         (optional . User-Agent))
   "*Headers to be generated or prompted for when posting an article.
 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
@@ -208,8 +222,7 @@ header, remove it from this list."
 
 (defcustom message-required-mail-headers
   '(From Subject Date (optional . In-Reply-To) Message-ID
-        (optional . User-Agent)
-        (optional . References))
+        (optional . User-Agent))
   "*Headers to be generated or prompted for when mailing a message.
 It is recommended that From, Date, To, Subject and Message-ID be
 included.  Organization and User-Agent are optional."
@@ -316,7 +329,7 @@ Archives \(such as groups.googgle.com\) respect this header."
 ;;;###autoload
 (defcustom message-archive-note
   "X-No-Archive: Yes - save http://groups.google.com/"
-  "Note to insert why you wouldn't want this posting archived. 
+  "Note to insert why you wouldn't want this posting archived.
 If nil, don't insert any text in the body."
   :type 'string
   :group 'message-various)
@@ -325,40 +338,40 @@ If nil, don't insert any text in the body."
 ;; inspired by JoH-followup-to by Jochem Huhman <joh  at gmx.de>
 ;; new suggestions by R. Weikusat <rw at another.de>
 
-(defvar message-xpost-old-target nil
+(defvar message-cross-post-old-target nil
   "Old target for cross-posts or follow-ups.")
-(make-variable-buffer-local 'message-xpost-old-target)
+(make-variable-buffer-local 'message-cross-post-old-target)
 
 ;;;###autoload
-(defcustom message-xpost-default t
-  "When non-nil `message-xpost-fup2' will normally perform a crosspost.
-If nil, `message-xpost-fup2' will only do a followup.  Note that you
-can explicitly override this setting by calling `message-xpost-fup2'
-with a prefix."
+(defcustom message-cross-post-default t
+  "When non-nil `message-cross-post-followup-to' will perform a crosspost.
+If nil, `message-cross-post-followup-to' will only do a followup.  Note that
+you can explicitly override this setting by calling
+`message-cross-post-followup-to' with a prefix."
   :type 'boolean
   :group 'message-various)
 
 ;;;###autoload
-(defcustom message-xpost-note
+(defcustom message-cross-post-note
   "Crosspost & Followup-To: "
-  "Note to insert before signature to notify of xpost and follow-up."
+  "Note to insert before signature to notify of cross-post and follow-up."
   :type 'string
   :group 'message-various)
 
 ;;;###autoload
-(defcustom message-fup2-note
+(defcustom message-followup-to-note
   "Followup-To: "
   "Note to insert before signature to notify of follow-up only."
   :type 'string
   :group 'message-various)
 
 ;;;###autoload
-(defcustom message-xpost-note-function
-  'message-xpost-insert-note
-  "Function to use to insert note about Crosspost or Followup-To.  
+(defcustom message-cross-post-note-function
+  'message-cross-post-insert-note
+  "Function to use to insert note about Crosspost or Followup-To.
 The function will be called with four arguments.  The function should not only
 insert a note, but also ensure old notes are deleted.  See the documentation
-for `message-xpost-insert-note'. "
+for `message-cross-post-insert-note'."
   :type 'function
   :group 'message-various)
 
@@ -623,6 +636,15 @@ Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
+(defcustom message-sendmail-envelope-from nil
+  "*Envelope-from when sending mail with sendmail.
+If this is nil, use `user-mail-address'.  If it is the symbol
+`header', use the From: header of the message."
+  :type '(choice (string :tag "From name")
+                (const :tag "Use From: header from message" header)
+                (const :tag "Use `user-mail-address'" nil))
+  :group 'message-sending)
+
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
   "Location of the qmail-inject program."
@@ -670,12 +692,16 @@ variable isn't used."
   "*If non-nil, generate all required headers before composing.
 The variables `message-required-news-headers' and
 `message-required-mail-headers' specify which headers to generate.
+This can also be a list of headers that should be generated before
+composing.
 
 Note that the variable `message-deletable-headers' specifies headers which
 are to be deleted and then re-generated before sending, so this variable
 will not have a visible effect for those headers."
   :group 'message-headers
-  :type 'boolean)
+  :type '(choice (const :tag "None" nil)
+                 (const :tag "All" t)
+                 (repeat (sexp :tag "Header"))))
 
 (defcustom message-setup-hook nil
   "Normal hook, run each time a new outgoing message is initialized.
@@ -786,6 +812,12 @@ If nil, don't insert a signature."
   :type '(choice file (const :tags "None" nil))
   :group 'message-insertion)
 
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+  "*If non-nil, insert an empty line before the signature separator."
+  :type 'boolean
+  :group 'message-insertion)
+
 (defcustom message-distribution-function nil
   "*Function called to return a Distribution header."
   :group 'message-news
@@ -938,12 +970,12 @@ A value of nil means exclude your own user name only."
   "*A list of GNKSA feet you are allowed to shoot.
 Gnus gives you all the opportunity you could possibly want for
 shooting yourself in the foot.  Also, Gnus allows you to shoot the
-feet of Good Net-Keeping Seal of Approval. The following are foot
+feet of Good Net-Keeping Seal of Approval.  The following are foot
 candidates:
 `empty-article'     Allow you to post an empty article;
 `quoted-text-only'  Allow you to post quoted text only;
 `multiple-copies'   Allow you to post multiple copies;
-`cancel-messages'   Allow you to cancel or supersede messages from 
+`cancel-messages'   Allow you to cancel or supersede messages from
                     your other email addresses.")
 
 (defsubst message-gnksa-enable-p (feature)
@@ -1155,18 +1187,23 @@ candidates:
 The cdr of each 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.
+This hook is run quite early when sending."
   :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.
+This hook is run very late -- just before the message is sent as
+mail."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-send-news-hook nil
-  "Hook run before sending news messages."
+  "Hook run before sending news messages.
+This hook is run very late -- just before the message is sent as
+news."
   :group 'message-various
   :type 'hook)
 
@@ -1245,6 +1282,12 @@ no, only reply back to the author."
   :group 'message-headers
   :type 'boolean)
 
+(defcustom message-user-fqdn nil
+  "*Domain part of Messsage-Ids."
+  :group 'message-headers
+  :link '(custom-manual "(message)News Headers")
+  :type 'string)
+
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")
@@ -1291,7 +1334,7 @@ no, only reply back to the author."
      ;; We want to match the results of any of these manglings.
      ;; The following regexp rejects names whose first characters are
      ;; obviously bogus, but after that anything goes.
-     "\\([^\0-\b\n-\r\^?].*\\)? "
+     "\\([^\0-\b\n-\r\^?].*\\)?"
 
      ;; The time the message was sent.
      "\\([^\0-\r \^?]+\\) +"           ; day of the week
@@ -1353,6 +1396,19 @@ no, only reply back to the author."
 (defvar message-bogus-system-names "^localhost\\."
   "The regexp of bogus system names.")
 
+(defcustom message-valid-fqdn-regexp
+  (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
+         ;; valid TLDs:
+         "\\([a-z][a-z]" ;; two letter country TDLs
+         "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
+         "\\|aero\\|coop\\|info\\|name\\|museum"
+         "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
+         "\\)")
+  "Regular expression that matches a valid FQDN."
+  ;; see also: gnus-button-valid-fqdn-regexp
+  :group 'message-headers
+  :type 'regexp)
+
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
@@ -1388,6 +1444,10 @@ no, only reply back to the author."
   `(delete-region (progn (beginning-of-line) (point))
                  (progn (forward-line ,(or n 1)) (point))))
 
+(defun message-mark-active-p ()
+  "Non-nil means the mark and region are currently active in this buffer."
+  mark-active)
+
 (defun message-unquote-tokens (elems)
   "Remove double quotes (\") from strings in list ELEMS."
   (mapcar (lambda (item)
@@ -1483,13 +1543,22 @@ is used by default."
            (insert (car headers) ?\n)))))
     (setq headers (cdr headers))))
 
+(defmacro message-with-reply-buffer (&rest forms)
+  "Evaluate FORMS in the reply buffer, if it exists."
+  `(when (and message-reply-buffer
+             (buffer-name message-reply-buffer))
+     (save-excursion
+       (set-buffer message-reply-buffer)
+       ,@forms)))
+
+(put 'message-with-reply-buffer 'lisp-indent-function 0)
+(put 'message-with-reply-buffer 'edebug-form-spec '(body))
 
 (defun message-fetch-reply-field (header)
   "Fetch field HEADER from the message we're replying to."
-  (when (and message-reply-buffer
-            (buffer-name message-reply-buffer))
-    (save-excursion
-      (set-buffer message-reply-buffer)
+  (message-with-reply-buffer
+    (save-restriction
+      (mail-narrow-to-head)
       (message-fetch-field header))))
 
 (defun message-set-work-buffer ()
@@ -1531,13 +1600,13 @@ is used by default."
 ;;; Start of functions adopted from `message-utils.el'.
 
 (defun message-strip-subject-trailing-was (subject)
-  "Remove trailing \"(Was: <old subject>)\" from subject lines.   
+  "Remove trailing \"(Was: <old subject>)\" from SUBJECT lines.
 Leading \"Re: \" is not stripped by this function.  Use the function
 `message-strip-subject-re' for this."
   (let* ((query message-subject-trailing-was-query)
         (new) (found))
     (setq found
-         (string-match 
+