cgit.sxemacs.org Git - gnus/blob - lisp/message.el

   1 ;;; message.el --- composing mail and news messages
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: mail, news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This mode provides mail-sending facilities from within Emacs.  It
  29 ;; consists mainly of large chunks of code from the sendmail.el,
  30 ;; gnus-msg.el and rnewspost.el files.
  31
  32 ;;; Code:
  33
  34 (eval-when-compile
  35   (require 'cl)
  36   (defvar gnus-message-group-art)
  37   (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
  38   (require 'hashcash))
  39 (require 'canlock)
  40 (require 'mailheader)
  41 (require 'nnheader)
  42 ;; This is apparently necessary even though things are autoloaded.
  43 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
  44 ;; require mailabbrev here.
  45 (if (featurep 'xemacs)
  46     (require 'mail-abbrevs)
  47   (require 'mailabbrev))
  48 (require 'mail-parse)
  49 (require 'mml)
  50 (require 'rfc822)
  51
  52 (defgroup message '((user-mail-address custom-variable)
  53                     (user-full-name custom-variable))
  54   "Mail and news message composing."
  55   :link '(custom-manual "(message)Top")
  56   :group 'mail
  57   :group 'news)
  58
  59 (put 'user-mail-address 'custom-type 'string)
  60 (put 'user-full-name 'custom-type 'string)
  61
  62 (defgroup message-various nil
  63   "Various Message Variables."
  64   :link '(custom-manual "(message)Various Message Variables")
  65   :group 'message)
  66
  67 (defgroup message-buffers nil
  68   "Message Buffers."
  69   :link '(custom-manual "(message)Message Buffers")
  70   :group 'message)
  71
  72 (defgroup message-sending nil
  73   "Message Sending."
  74   :link '(custom-manual "(message)Sending Variables")
  75   :group 'message)
  76
  77 (defgroup message-interface nil
  78   "Message Interface."
  79   :link '(custom-manual "(message)Interface")
  80   :group 'message)
  81
  82 (defgroup message-forwarding nil
  83   "Message Forwarding."
  84   :link '(custom-manual "(message)Forwarding")
  85   :group 'message-interface)
  86
  87 (defgroup message-insertion nil
  88   "Message Insertion."
  89   :link '(custom-manual "(message)Insertion")
  90   :group 'message)
  91
  92 (defgroup message-headers nil
  93   "Message Headers."
  94   :link '(custom-manual "(message)Message Headers")
  95   :group 'message)
  96
  97 (defgroup message-news nil
  98   "Composing News Messages."
  99   :group 'message)
 100
 101 (defgroup message-mail nil
 102   "Composing Mail Messages."
 103   :group 'message)
 104
 105 (defgroup message-faces nil
 106   "Faces used for message composing."
 107   :group 'message
 108   :group 'faces)
 109
 110 (defcustom message-directory "~/Mail/"
 111   "*Directory from which all other mail file variables are derived."
 112   :group 'message-various
 113   :type 'directory)
 114
 115 (defcustom message-max-buffers 10
 116   "*How many buffers to keep before starting to kill them off."
 117   :group 'message-buffers
 118   :type 'integer)
 119
 120 (defcustom message-send-rename-function nil
 121   "Function called to rename the buffer after sending it."
 122   :group 'message-buffers
 123   :type '(choice function (const nil)))
 124
 125 (defcustom message-fcc-handler-function 'message-output
 126   "*A function called to save outgoing articles.
 127 This function will be called with the name of the file to store the
 128 article in.  The default function is `message-output' which saves in Unix
 129 mailbox format."
 130   :type '(radio (function-item message-output)
 131                 (function :tag "Other"))
 132   :group 'message-sending)
 133
 134 (defcustom message-fcc-externalize-attachments nil
 135   "If non-nil, attachments are included as external parts in Fcc copies."
 136   :version "22.1"
 137   :type 'boolean
 138   :group 'message-sending)
 139
 140 (defcustom message-courtesy-message
 141   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 142   "*This is inserted at the start of a mailed copy of a posted message.
 143 If the string contains the format spec \"%s\", the Newsgroups
 144 the article has been posted to will be inserted there.
 145 If this variable is nil, no such courtesy message will be added."
 146   :group 'message-sending
 147   :type '(radio string (const nil)))
 148
 149 (defcustom message-ignored-bounced-headers
 150   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
 151   "*Regexp that matches headers to be removed in resent bounced mail."
 152   :group 'message-interface
 153   :type 'regexp)
 154
 155 ;;;###autoload
 156 (defcustom message-from-style 'default
 157   "*Specifies how \"From\" headers look.
 158
 159 If nil, they contain just the return address like:
 160         king@grassland.com
 161 If `parens', they look like:
 162         king@grassland.com (Elvis Parsley)
 163 If `angles', they look like:
 164         Elvis Parsley <king@grassland.com>
 165
 166 Otherwise, most addresses look like `angles', but they look like
 167 `parens' if `angles' would need quoting and `parens' would not."
 168   :type '(choice (const :tag "simple" nil)
 169                  (const parens)
 170                  (const angles)
 171                  (const default))
 172   :group 'message-headers)
 173
 174 (defcustom message-insert-canlock t
 175   "Whether to insert a Cancel-Lock header in news postings."
 176   :version "22.1"
 177   :group 'message-headers
 178   :type 'boolean)
 179
 180 (defcustom message-syntax-checks
 181   (if message-insert-canlock '((sender . disabled)) nil)
 182   ;; Guess this one shouldn't be easy to customize...
 183   "*Controls what syntax checks should not be performed on outgoing posts.
 184 To disable checking of long signatures, for instance, add
 185  `(signature . disabled)' to this list.
 186
 187 Don't touch this variable unless you really know what you're doing.
 188
 189 Checks include `subject-cmsg', `multiple-headers', `sendsys',
 190 `message-id', `from', `long-lines', `control-chars', `size',
 191 `new-text', `quoting-style', `redirected-followup', `signature',
 192 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 193 `subject', `shorten-followup-to', `existing-newsgroups',
 194 `buffer-file-name', `unchanged', `newsgroups', `reply-to',
 195 `continuation-headers', `long-header-lines', `invisible-text' and
 196 `illegible-text'."
 197   :group 'message-news
 198   :type '(repeat sexp))                 ; Fixme: improve this
 199
 200 (defcustom message-required-headers '((optional . References)
 201                                       From)
 202   "*Headers to be generated or prompted for when sending a message.
 203 Also see `message-required-news-headers' and
 204 `message-required-mail-headers'."
 205   :version "22.1"
 206   :group 'message-news
 207   :group 'message-headers
 208   :link '(custom-manual "(message)Message Headers")
 209   :type '(repeat sexp))
 210
 211 (defcustom message-draft-headers '(References From)
 212   "*Headers to be generated when saving a draft message."
 213   :version "22.1"
 214   :group 'message-news
 215   :group 'message-headers
 216   :link '(custom-manual "(message)Message Headers")
 217   :type '(repeat sexp))
 218
 219 (defcustom message-required-news-headers
 220   '(From Newsgroups Subject Date Message-ID
 221          (optional . Organization)
 222          (optional . User-Agent))
 223   "*Headers to be generated or prompted for when posting an article.
 224 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 225 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 226 User-Agent are optional.  If don't you want message to insert some
 227 header, remove it from this list."
 228   :group 'message-news
 229   :group 'message-headers
 230   :link '(custom-manual "(message)Message Headers")
 231   :type '(repeat sexp))
 232
 233 (defcustom message-required-mail-headers
 234   '(From Subject Date (optional . In-Reply-To) Message-ID
 235          (optional . User-Agent))
 236   "*Headers to be generated or prompted for when mailing a message.
 237 It is recommended that From, Date, To, Subject and Message-ID be
 238 included.  Organization and User-Agent are optional."
 239   :group 'message-mail
 240   :group 'message-headers
 241   :link '(custom-manual "(message)Message Headers")
 242   :type '(repeat sexp))
 243
 244 (defcustom message-deletable-headers '(Message-ID Date Lines)
 245   "Headers to be deleted if they already exist and were generated by message previously."
 246   :group 'message-headers
 247   :link '(custom-manual "(message)Message Headers")
 248   :type 'sexp)
 249
 250 (defcustom message-ignored-news-headers
 251   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 252   "*Regexp of headers to be removed unconditionally before posting."
 253   :group 'message-news
 254   :group 'message-headers
 255   :link '(custom-manual "(message)Message Headers")
 256   :type '(repeat :value-to-internal (lambda (widget value)
 257                                       (custom-split-regexp-maybe value))
 258                  :match (lambda (widget value)
 259                           (or (stringp value)
 260                               (widget-editable-list-match widget value)))
 261                  regexp))
 262
 263 (defcustom message-ignored-mail-headers
 264   "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 265   "*Regexp of headers to be removed unconditionally before mailing."
 266   :group 'message-mail
 267   :group 'message-headers
 268   :link '(custom-manual "(message)Mail Headers")
 269   :type 'regexp)
 270
 271 (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
 272   "*Header lines matching this regexp will be deleted before posting.
 273 It's best to delete old Path and Date headers before posting to avoid
 274 any confusion."
 275   :group 'message-interface
 276   :link '(custom-manual "(message)Superseding")
 277   :type '(repeat :value-to-internal (lambda (widget value)
 278                                       (custom-split-regexp-maybe value))
 279                  :match (lambda (widget value)
 280                           (or (stringp value)
 281                               (widget-editable-list-match widget value)))
 282                  regexp))
 283
 284 (defcustom message-subject-re-regexp
 285   "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
 286   "*Regexp matching \"Re: \" in the subject line."
 287   :group 'message-various
 288   :link '(custom-manual "(message)Message Headers")
 289   :type 'regexp)
 290
 291 ;;; Start of variables adopted from `message-utils.el'.
 292
 293 (defcustom message-subject-trailing-was-query 'ask
 294   "*What to do with trailing \"(was: <old subject>)\" in subject lines.
 295 If nil, leave the subject unchanged.  If it is the symbol `ask', query
 296 the user what do do.  In this case, the subject is matched against
 297 `message-subject-trailing-was-ask-regexp'.  If
 298 `message-subject-trailing-was-query' is t, always strip the trailing
 299 old subject.  In this case, `message-subject-trailing-was-regexp' is
 300 used."
 301   :version "22.1"
 302   :type '(choice (const :tag "never" nil)
 303                  (const :tag "always strip" t)
 304                  (const ask))
 305   :link '(custom-manual "(message)Message Headers")
 306   :group 'message-various)
 307
 308 (defcustom message-subject-trailing-was-ask-regexp
 309   "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
 310   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 311
 312 The function `message-strip-subject-trailing-was' uses this regexp if
 313 `message-subject-trailing-was-query' is set to the symbol `ask'.  If
 314 the variable is t instead of `ask', use
 315 `message-subject-trailing-was-regexp' instead.
 316
 317 It is okay to create some false positives here, as the user is asked."
 318   :version "22.1"
 319   :group 'message-various
 320   :link '(custom-manual "(message)Message Headers")
 321   :type 'regexp)
 322
 323 (defcustom message-subject-trailing-was-regexp
 324   "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
 325   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 326
 327 If `message-subject-trailing-was-query' is set to t, the subject is
 328 matched against `message-subject-trailing-was-regexp' in
 329 `message-strip-subject-trailing-was'.  You should use a regexp creating very
 330 few false positives here."
 331   :version "22.1"
 332   :group 'message-various
 333   :link '(custom-manual "(message)Message Headers")
 334   :type 'regexp)
 335
 336 ;;; marking inserted text
 337
 338 (defcustom message-mark-insert-begin
 339   "--8<---------------cut here---------------start------------->8---\n"
 340   "How to mark the beginning of some inserted text."
 341   :version "22.1"
 342   :type 'string
 343   :link '(custom-manual "(message)Insertion Variables")
 344   :group 'message-various)
 345
 346 (defcustom message-mark-insert-end
 347   "--8<---------------cut here---------------end--------------->8---\n"
 348   "How to mark the end of some inserted text."
 349   :version "22.1"
 350   :type 'string
 351   :link '(custom-manual "(message)Insertion Variables")
 352   :group 'message-various)
 353
 354 (defcustom message-archive-header "X-No-Archive: Yes\n"
 355   "Header to insert when you don't want your article to be archived.
 356 Archives \(such as groups.google.com\) respect this header."
 357   :version "22.1"
 358   :type 'string
 359   :link '(custom-manual "(message)Header Commands")
 360   :group 'message-various)
 361
 362 (defcustom message-archive-note
 363   "X-No-Archive: Yes - save http://groups.google.com/"
 364   "Note to insert why you wouldn't want this posting archived.
 365 If nil, don't insert any text in the body."
 366   :version "22.1"
 367   :type '(radio string (const nil))
 368   :link '(custom-manual "(message)Header Commands")
 369   :group 'message-various)
 370
 371 ;;; Crossposts and Followups
 372 ;; inspired by JoH-followup-to by Jochem Huhman <joh  at gmx.de>
 373 ;; new suggestions by R. Weikusat <rw at another.de>
 374
 375 (defvar message-cross-post-old-target nil
 376   "Old target for cross-posts or follow-ups.")
 377 (make-variable-buffer-local 'message-cross-post-old-target)
 378
 379 (defcustom message-cross-post-default t
 380   "When non-nil `message-cross-post-followup-to' will perform a crosspost.
 381 If nil, `message-cross-post-followup-to' will only do a followup.  Note that
 382 you can explicitly override this setting by calling
 383 `message-cross-post-followup-to' with a prefix."
 384   :version "22.1"
 385   :type 'boolean
 386   :group 'message-various)
 387
 388 (defcustom message-cross-post-note "Crosspost & Followup-To: "
 389   "Note to insert before signature to notify of cross-post and follow-up."
 390   :version "22.1"
 391   :type 'string
 392   :group 'message-various)
 393
 394 (defcustom message-followup-to-note "Followup-To: "
 395   "Note to insert before signature to notify of follow-up only."
 396   :version "22.1"
 397   :type 'string
 398   :group 'message-various)
 399
 400 (defcustom message-cross-post-note-function 'message-cross-post-insert-note
 401   "Function to use to insert note about Crosspost or Followup-To.
 402 The function will be called with four arguments.  The function should not only
 403 insert a note, but also ensure old notes are deleted.  See the documentation
 404 for `message-cross-post-insert-note'."
 405   :version "22.1"
 406   :type 'function
 407   :group 'message-various)
 408
 409 ;;; End of variables adopted from `message-utils.el'.
 410
 411 ;;;###autoload
 412 (defcustom message-signature-separator "^-- *$"
 413   "Regexp matching the signature separator."
 414   :type 'regexp
 415   :link '(custom-manual "(message)Various Message Variables")
 416   :group 'message-various)
 417
 418 (defcustom message-elide-ellipsis "\n[...]\n\n"
 419   "*The string which is inserted for elided text."
 420   :type 'string
 421   :link '(custom-manual "(message)Various Commands")
 422   :group 'message-various)
 423
 424 (defcustom message-interactive t
 425   "Non-nil means when sending a message wait for and display errors.
 426 nil means let mailer mail back a message to report errors."
 427   :group 'message-sending
 428   :group 'message-mail
 429   :link '(custom-manual "(message)Sending Variables")
 430   :type 'boolean)
 431
 432 (defcustom message-generate-new-buffers 'unique
 433   "*Non-nil means create a new message buffer whenever `message-setup' is called.
 434 If this is a function, call that function with three parameters:  The type,
 435 the to address and the group name.  (Any of these may be nil.)  The function
 436 should return the new buffer name."
 437   :group 'message-buffers
 438   :link '(custom-manual "(message)Message Buffers")
 439   :type '(choice (const :tag "off" nil)
 440                  (const :tag "unique" unique)
 441                  (const :tag "unsent" unsent)
 442                  (function fun)))
 443
 444 (defcustom message-kill-buffer-on-exit nil
 445   "*Non-nil means that the message buffer will be killed after sending a message."
 446   :group 'message-buffers
 447   :link '(custom-manual "(message)Message Buffers")
 448   :type 'boolean)
 449
 450 (defcustom message-kill-buffer-query t
 451   "*Non-nil means that killing a modified message buffer has to be confirmed.
 452 This is used by `message-kill-buffer'."
 453   :version "23.0" ;; No Gnus
 454   :group 'message-buffers
 455   :type 'boolean)
 456
 457 (eval-when-compile
 458   (defvar gnus-local-organization))
 459 (defcustom message-user-organization
 460   (or (and (boundp 'gnus-local-organization)
 461            (stringp gnus-local-organization)
 462            gnus-local-organization)
 463       (getenv "ORGANIZATION")
 464       t)
 465   "*String to be used as an Organization header.
 466 If t, use `message-user-organization-file'."
 467   :group 'message-headers
 468   :type '(choice string
 469                  (const :tag "consult file" t)))
 470
 471 ;;;###autoload
 472 (defcustom message-user-organization-file "/usr/lib/news/organization"
 473   "*Local news organization file."
 474   :type 'file
 475   :link '(custom-manual "(message)News Headers")
 476   :group 'message-headers)
 477
 478 (defcustom message-make-forward-subject-function
 479   #'message-forward-subject-name-subject
 480   "*List of functions called to generate subject headers for forwarded messages.
 481 The subject generated by the previous function is passed into each
 482 successive function.
 483
 484 The provided functions are:
 485
 486 * `message-forward-subject-author-subject' Source of article (author or
 487       newsgroup), in brackets followed by the subject
 488 * `message-forward-subject-name-subject' Source of article (name of author
 489       or newsgroup), in brackets followed by the subject
 490 * `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
 491       to it."
 492   :group 'message-forwarding
 493   :link '(custom-manual "(message)Forwarding")
 494   :type '(radio (function-item message-forward-subject-author-subject)
 495                 (function-item message-forward-subject-fwd)
 496                 (function-item message-forward-subject-name-subject)
 497                 (repeat :tag "List of functions" function)))
 498
 499 (defcustom message-forward-as-mime t
 500   "*Non-nil means forward messages as an inline/rfc822 MIME section.
 501 Otherwise, directly inline the old message in the forwarded message."
 502   :version "21.1"
 503   :group 'message-forwarding
 504   :link '(custom-manual "(message)Forwarding")
 505   :type 'boolean)
 506
 507 (defcustom message-forward-show-mml 'best
 508   "*Non-nil means show forwarded messages as MML (decoded from MIME).
 509 Otherwise, forwarded messages are unchanged.
 510 Can also be the symbol `best' to indicate that MML should be
 511 used, except when it is a bad idea to use MML.  One example where
 512 it is a bad idea is when forwarding a signed or encrypted
 513 message, because converting MIME to MML would invalidate the
 514 digital signature."
 515   :version "21.1"
 516   :group 'message-forwarding
 517   :type '(choice (const :tag "use MML" t)
 518                  (const :tag "don't use MML " nil)
 519                  (const :tag "use MML when appropriate" best)))
 520
 521 (defcustom message-forward-before-signature t
 522   "*Non-nil means put forwarded message before signature, else after."
 523   :group 'message-forwarding
 524   :type 'boolean)
 525
 526 (defcustom message-wash-forwarded-subjects nil
 527   "*Non-nil means try to remove as much cruft as possible from the subject.
 528 Done before generating the new subject of a forward."
 529   :group 'message-forwarding
 530   :link '(custom-manual "(message)Forwarding")
 531   :type 'boolean)
 532
 533 (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
 534   "*All headers that match this regexp will be deleted when resending a message."
 535   :group 'message-interface
 536   :link '(custom-manual "(message)Resending")
 537   :type '(repeat :value-to-internal (lambda (widget value)
 538                                       (custom-split-regexp-maybe value))
 539                  :match (lambda (widget value)
 540                           (or (stringp value)
 541                               (widget-editable-list-match widget value)))
 542                  regexp))
 543
 544 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
 545   "*All headers that match this regexp will be deleted when forwarding a message."
 546   :version "21.1"
 547   :group 'message-forwarding
 548   :type '(repeat :value-to-internal (lambda (widget value)
 549                                       (custom-split-regexp-maybe value))
 550                  :match (lambda (widget value)
 551                           (or (stringp value)
 552                               (widget-editable-list-match widget value)))
 553                  regexp))
 554
 555 (defcustom message-ignored-cited-headers "."
 556   "*Delete these headers from the messages you yank."
 557   :group 'message-insertion
 558   :link '(custom-manual "(message)Insertion Variables")
 559   :type 'regexp)
 560
 561 (defcustom message-cite-prefix-regexp
 562   (if (string-match "[[:digit:]]" "1") ;; support POSIX?
 563       "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
 564     ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
 565     (let (non-word-constituents)
 566       (with-syntax-table text-mode-syntax-table
 567         (setq non-word-constituents
 568               (concat
 569                (if (string-match "\\w" "-")  "" "-")
 570                (if (string-match "\\w" "_")  "" "_")
 571                (if (string-match "\\w" ".")  "" "."))))
 572       (if (equal non-word-constituents "")
 573           "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
 574         (concat "\\([ \t]*\\(\\w\\|["
 575                 non-word-constituents
 576                 "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
 577   "*Regexp matching the longest possible citation prefix on a line."
 578   :version "22.1"
 579   :group 'message-insertion
 580   :link '(custom-manual "(message)Insertion Variables")
 581   :type 'regexp)
 582
 583 (defcustom message-cancel-message "I am canceling my own article.\n"
 584   "Message to be inserted in the cancel message."
 585   :group 'message-interface
 586   :link '(custom-manual "(message)Canceling News")
 587   :type 'string)
 588
 589 ;; Useful to set in site-init.el
 590 ;;;###autoload
 591 (defcustom message-send-mail-function
 592   (let ((program (if (boundp 'sendmail-program)
 593                      ;; see paths.el
 594                      sendmail-program)))
 595     (cond
 596      ((and program
 597            (string-match "/" program) ;; Skip path
 598            (file-executable-p program))
 599       'message-send-mail-with-sendmail)
 600      ((and program
 601            (executable-find program))
 602       'message-send-mail-with-sendmail)
 603      (t
 604       'smtpmail-send-it)))
 605   "Function to call to send the current buffer as mail.
 606 The headers should be delimited by a line whose contents match the
 607 variable `mail-header-separator'.
 608
 609 Valid values include `message-send-mail-with-sendmail' (the default),
 610 `message-send-mail-with-mh', `message-send-mail-with-qmail',
 611 `message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
 612
 613 See also `send-mail-function'."
 614   :type '(radio (function-item message-send-mail-with-sendmail)
 615                 (function-item message-send-mail-with-mh)
 616                 (function-item message-send-mail-with-qmail)
 617                 (function-item message-smtpmail-send-it)
 618                 (function-item smtpmail-send-it)
 619                 (function-item feedmail-send-it)
 620                 (function :tag "Other"))
 621   :group 'message-sending
 622   :link '(custom-manual "(message)Mail Variables")
 623   :group 'message-mail)
 624
 625 (defcustom message-send-news-function 'message-send-news
 626   "Function to call to send the current buffer as news.
 627 The headers should be delimited by a line whose contents match the
 628 variable `mail-header-separator'."
 629   :group 'message-sending
 630   :group 'message-news
 631   :link '(custom-manual "(message)News Variables")
 632   :type 'function)
 633
 634 (defcustom message-reply-to-function nil
 635   "If non-nil, function that should return a list of headers.
 636 This function should pick out addresses from the To, Cc, and From headers
 637 and respond with new To and Cc headers."
 638   :group 'message-interface
 639   :link '(custom-manual "(message)Reply")
 640   :type '(choice function (const nil)))
 641
 642 (defcustom message-wide-reply-to-function nil
 643   "If non-nil, function that should return a list of headers.
 644 This function should pick out addresses from the To, Cc, and From headers
 645 and respond with new To and Cc headers."
 646   :group 'message-interface
 647   :link '(custom-manual "(message)Wide Reply")
 648   :type '(choice function (const nil)))
 649
 650 (defcustom message-followup-to-function nil
 651   "If non-nil, function that should return a list of headers.
 652 This function should pick out addresses from the To, Cc, and From headers
 653 and respond with new To and Cc headers."
 654   :group 'message-interface
 655   :link '(custom-manual "(message)Followup")
 656   :type '(choice function (const nil)))
 657
 658 (defcustom message-extra-wide-headers nil
 659   "If non-nil, a list of additional address headers.
 660 These are used when composing a wide reply."
 661   :group 'message-sending
 662   :type '(repeat string))
 663
 664 (defcustom message-use-followup-to 'ask
 665   "*Specifies what to do with Followup-To header.
 666 If nil, always ignore the header.  If it is t, use its value, but
 667 query before using the \"poster\" value.  If it is the symbol `ask',
 668 always query the user whether to use the value.  If it is the symbol
 669 `use', always use the value."
 670   :group 'message-interface
 671   :link '(custom-manual "(message)Followup")
 672   :type '(choice (const :tag "ignore" nil)
 673                  (const :tag "use & query" t)
 674                  (const use)
 675                  (const ask)))
 676
 677 (defcustom message-use-mail-followup-to 'use
 678   "*Specifies what to do with Mail-Followup-To header.
 679 If nil, always ignore the header.  If it is the symbol `ask', always
 680 query the user whether to use the value.  If it is the symbol `use',
 681 always use the value."
 682   :version "22.1"
 683   :group 'message-interface
 684   :link '(custom-manual "(message)Mailing Lists")
 685   :type '(choice (const :tag "ignore" nil)
 686                  (const use)
 687                  (const ask)))
 688
 689 (defcustom message-subscribed-address-functions nil
 690   "*Specifies functions for determining list subscription.
 691 If nil, do not attempt to determine list subscription with functions.
 692 If non-nil, this variable contains a list of functions which return
 693 regular expressions to match lists.  These functions can be used in
 694 conjunction with `message-subscribed-regexps' and
 695 `message-subscribed-addresses'."
 696   :version "22.1"
 697   :group 'message-interface
 698   :link '(custom-manual "(message)Mailing Lists")
 699   :type '(repeat sexp))
 700
 701 (defcustom message-subscribed-address-file nil
 702   "*A file containing addresses the user is subscribed to.
 703 If nil, do not look at any files to determine list subscriptions.  If
 704 non-nil, each line of this file should be a mailing list address."
 705   :version "22.1"
 706   :group 'message-interface
 707   :link '(custom-manual "(message)Mailing Lists")
 708   :type '(radio file (const nil)))
 709
 710 (defcustom message-subscribed-addresses nil
 711   "*Specifies a list of addresses the user is subscribed to.
 712 If nil, do not use any predefined list subscriptions.  This list of
 713 addresses can be used in conjunction with
 714 `message-subscribed-address-functions' and `message-subscribed-regexps'."
 715   :version "22.1"
 716   :group 'message-interface
 717   :link '(custom-manual "(message)Mailing Lists")
 718   :type '(repeat string))
 719
 720 (defcustom message-subscribed-regexps nil
 721   "*Specifies a list of addresses the user is subscribed to.
 722 If nil, do not use any predefined list subscriptions.  This list of
 723 regular expressions can be used in conjunction with
 724 `message-subscribed-address-functions' and `message-subscribed-addresses'."
 725   :version "22.1"
 726   :group 'message-interface
 727   :link '(custom-manual "(message)Mailing Lists")
 728   :type '(repeat regexp))
 729
 730 (defcustom message-allow-no-recipients 'ask
 731   "Specifies what to do when there are no recipients other than Gcc/Fcc.
 732 If it is the symbol `always', the posting is allowed.  If it is the
 733 symbol `never', the posting is not allowed.  If it is the symbol
 734 `ask', you are prompted."
 735   :version "22.1"
 736   :group 'message-interface
 737   :link '(custom-manual "(message)Message Headers")
 738   :type '(choice (const always)
 739                  (const never)
 740                  (const ask)))
 741
 742 (defcustom message-sendmail-f-is-evil nil
 743   "*Non-nil means don't add \"-f username\" to the sendmail command line.
 744 Doing so would be even more evil than leaving it out."
 745   :group 'message-sending
 746   :link '(custom-manual "(message)Mail Variables")
 747   :type 'boolean)
 748
 749 (defcustom message-sendmail-envelope-from nil
 750   "*Envelope-from when sending mail with sendmail.
 751 If this is nil, use `user-mail-address'.  If it is the symbol
 752 `header', use the From: header of the message."
 753   :version "22.1"
 754   :type '(choice (string :tag "From name")
 755                  (const :tag "Use From: header from message" header)
 756                  (const :tag "Use `user-mail-address'" nil))
 757   :link '(custom-manual "(message)Mail Variables")
 758   :group 'message-sending)
 759
 760 ;; qmail-related stuff
 761 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
 762   "Location of the qmail-inject program."
 763   :group 'message-sending
 764   :link '(custom-manual "(message)Mail Variables")
 765   :type 'file)
 766
 767 (defcustom message-qmail-inject-args nil
 768   "Arguments passed to qmail-inject programs.
 769 This should be a list of strings, one string for each argument.  It
 770 may also be a function.
 771
 772 For e.g., if you wish to set the envelope sender address so that bounces
 773 go to the right place or to deal with listserv's usage of that address, you
 774 might set this variable to '(\"-f\" \"you@some.where\")."
 775   :group 'message-sending
 776   :link '(custom-manual "(message)Mail Variables")
 777   :type '(choice (function)
 778                  (repeat string)))
 779
 780 (eval-when-compile
 781   (defvar gnus-post-method)
 782   (defvar gnus-select-method))
 783 (defcustom message-post-method
 784   (cond ((and (boundp 'gnus-post-method)
 785               (listp gnus-post-method)
 786               gnus-post-method)
 787          gnus-post-method)
 788         ((boundp 'gnus-select-method)
 789          gnus-select-method)
 790         (t '(nnspool "")))
 791   "*Method used to post news.
 792 Note that when posting from inside Gnus, for instance, this
 793 variable isn't used."
 794   :group 'message-news
 795   :group 'message-sending
 796   ;; This should be the `gnus-select-method' widget, but that might
 797   ;; create a dependence to `gnus.el'.
 798   :type 'sexp)
 799
 800 ;; FIXME: This should be a temporary workaround until someone implements a
 801 ;; proper solution.  If a crash happens while replying, the auto-save file
 802 ;; will *not* have a `References:' header if `message-generate-headers-first'
 803 ;; is nil.  See: http://article.gmane.org/gmane.emacs.gnus.general/51138
 804 (defcustom message-generate-headers-first '(references)
 805   "Which headers should be generated before starting to compose a message.
 806 If t, generate all required headers.  This can also be a list of headers to
 807 generate.  The variables `message-required-news-headers' and
 808 `message-required-mail-headers' specify which headers to generate.
 809
 810 Note that the variable `message-deletable-headers' specifies headers which
 811 are to be deleted and then re-generated before sending, so this variable
 812 will not have a visible effect for those headers."
 813   :group 'message-headers
 814   :link '(custom-manual "(message)Message Headers")
 815   :type '(choice (const :tag "None" nil)
 816                  (const :tag "References" '(references))
 817                  (const :tag "All" t)
 818                  (repeat (sexp :tag "Header"))))
 819
 820 (defcustom message-setup-hook nil
 821   "Normal hook, run each time a new outgoing message is initialized.
 822 The function `message-setup' runs this hook."
 823   :group 'message-various
 824   :link '(custom-manual "(message)Various Message Variables")
 825   :type 'hook)
 826
 827 (defcustom message-cancel-hook nil
 828   "Hook run when cancelling articles."
 829   :group 'message-various
 830   :link '(custom-manual "(message)Various Message Variables")
 831   :type 'hook)
 832
 833 (defcustom message-signature-setup-hook nil
 834   "Normal hook, run each time a new outgoing message is initialized.
 835 It is run after the headers have been inserted and before
 836 the signature is inserted."
 837   :group 'message-various
 838   :link '(custom-manual "(message)Various Message Variables")
 839   :type 'hook)
 840
 841 (defcustom message-mode-hook nil
 842   "Hook run in message mode buffers."
 843   :group 'message-various
 844   :type 'hook)
 845
 846 (defcustom message-header-hook nil
 847   "Hook run in a message mode buffer narrowed to the headers."
 848   :group 'message-various
 849   :type 'hook)
 850
 851 (defcustom message-header-setup-hook nil
 852   "Hook called narrowed to the headers when setting up a message buffer."
 853   :group 'message-various
 854   :link '(custom-manual "(message)Various Message Variables")
 855   :type 'hook)
 856
 857 (defcustom message-minibuffer-local-map
 858   (let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
 859     (set-keymap-parent map minibuffer-local-map)
 860     map)
 861   "Keymap for `message-read-from-minibuffer'."
 862   :version "22.1"
 863   :group 'message-various)
 864
 865 ;;;###autoload
 866 (defcustom message-citation-line-function 'message-insert-citation-line
 867   "*Function called to insert the \"Whomever writes:\" line.
 868
 869 Note that Gnus provides a feature where the reader can click on
 870 `writes:' to hide the cited text.  If you change this line too much,
 871 people who read your message will have to change their Gnus
 872 configuration.  See the variable `gnus-cite-attribution-suffix'."
 873   :type 'function
 874   :link '(custom-manual "(message)Insertion Variables")
 875   :group 'message-insertion)
 876
 877 ;;;###autoload
 878 (defcustom message-yank-prefix "> "
 879   "*Prefix inserted on the lines of yanked messages.
 880 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
 881 See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
 882   :type 'string
 883   :link '(custom-manual "(message)Insertion Variables")
 884   :group 'message-insertion)
 885
 886 (defcustom message-yank-cited-prefix ">"
 887   "*Prefix inserted on cited lines of yanked messages.
 888 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
 889 See also `message-yank-prefix' and `message-yank-empty-prefix'."
 890   :version "22.1"
 891   :type 'string
 892   :link '(custom-manual "(message)Insertion Variables")
 893   :group 'message-insertion)
 894
 895 (defcustom message-yank-empty-prefix ">"
 896   "*Prefix inserted on empty lines of yanked messages.
 897 See also `message-yank-prefix' and `message-yank-cited-prefix'."
 898   :version "22.1"
 899   :type 'string
 900   :link '(custom-manual "(message)Insertion Variables")
 901   :group 'message-insertion)
 902
 903 (defcustom message-indentation-spaces 3
 904   "*Number of spaces to insert at the beginning of each cited line.
 905 Used by `message-yank-original' via `message-yank-cite'."
 906   :group 'message-insertion
 907   :link '(custom-manual "(message)Insertion Variables")
 908   :type 'integer)
 909
 910 ;;;###autoload
 911 (defcustom message-cite-function 'message-cite-original
 912   "*Function for citing an original message.
 913 Predefined functions include `message-cite-original' and
 914 `message-cite-original-without-signature'.
 915 Note that these functions use `mail-citation-hook' if that is non-nil."
 916   :type '(radio (function-item message-cite-original)
 917                 (function-item message-cite-original-without-signature)
 918                 (function-item sc-cite-original)
 919                 (function :tag "Other"))
 920   :link '(custom-manual "(message)Insertion Variables")
 921   :group 'message-insertion)
 922
 923 ;;;###autoload
 924 (defcustom message-indent-citation-function 'message-indent-citation
 925   "*Function for modifying a citation just inserted in the mail buffer.
 926 This can also be a list of functions.  Each function can find the
 927 citation between (point) and (mark t).  And each function should leave
 928 point and mark around the citation text as modified."
 929   :type 'function
 930   :link '(custom-manual "(message)Insertion Variables")
 931   :group 'message-insertion)
 932
 933 ;;;###autoload
 934 (defcustom message-signature t
 935   "*String to be inserted at the end of the message buffer.
 936 If t, the `message-signature-file' file will be inserted instead.
 937 If a function, the result from the function will be used instead.
 938 If a form, the result from the form will be used instead."
 939   :type 'sexp
 940   :link '(custom-manual "(message)Insertion Variables")
 941   :group 'message-insertion)
 942
 943 ;;;###autoload
 944 (defcustom message-signature-file "~/.signature"
 945   "*Name of file containing the text inserted at end of message buffer.
 946 Ignored if the named file doesn't exist.
 947 If nil, don't insert a signature."
 948   :type '(choice file (const :tags "None" nil))
 949   :link '(custom-manual "(message)Insertion Variables")
 950   :group 'message-insertion)
 951
 952 ;;;###autoload
 953 (defcustom message-signature-insert-empty-line t
 954   "*If non-nil, insert an empty line before the signature separator."
 955   :version "22.1"
 956   :type 'boolean
 957   :link '(custom-manual "(message)Insertion Variables")
 958   :group 'message-insertion)
 959
 960 (defcustom message-distribution-function nil
 961   "*Function called to return a Distribution header."
 962   :group 'message-news
 963   :group 'message-headers
 964   :link '(custom-manual "(message)News Headers")
 965   :type '(choice function (const nil)))
 966
 967 (defcustom message-expires 14
 968   "Number of days before your article expires."
 969   :group 'message-news
 970   :group 'message-headers
 971   :link '(custom-manual "(message)News Headers")
 972   :type 'integer)
 973
 974 (defcustom message-user-path nil
 975   "If nil, use the NNTP server name in the Path header.
 976 If stringp, use this; if non-nil, use no host name (user name only)."
 977   :group 'message-news
 978   :group 'message-headers
 979   :link '(custom-manual "(message)News Headers")
 980   :type '(choice (const :tag "nntp" nil)
 981                  (string :tag "name")
 982                  (sexp :tag "none" :format "%t" t)))
 983
 984 (defvar message-reply-buffer nil)
 985 (defvar message-reply-headers nil
 986   "The headers of the current replied article.
 987 It is a vector of the following headers:
 988 \[number subject from date id references chars lines xref extra].")
 989 (defvar message-newsreader nil)
 990 (defvar message-mailer nil)
 991 (defvar message-sent-message-via nil)
 992 (defvar message-checksum nil)
 993 (defvar message-send-actions nil
 994   "A list of actions to be performed upon successful sending of a message.")
 995 (defvar message-exit-actions nil
 996   "A list of actions to be performed upon exiting after sending a message.")
 997 (defvar message-kill-actions nil
 998   "A list of actions to be performed before killing a message buffer.")
 999 (defvar message-postpone-actions nil
1000   "A list of actions to be performed after postponing a message.")
1001
1002 (define-widget 'message-header-lines 'text
1003   "All header lines must be LFD terminated."
1004   :format "%{%t%}:%n%v"
1005   :valid-regexp "^\\'"
1006   :error "All header lines must be newline terminated")
1007
1008 (defcustom message-default-headers ""
1009   "*A string containing header lines to be inserted in outgoing messages.
1010 It is inserted before you edit the message, so you can edit or delete
1011 these lines."
1012   :group 'message-headers
1013   :link '(custom-manual "(message)Message Headers")
1014   :type 'message-header-lines)
1015
1016 (defcustom message-default-mail-headers ""
1017   "*A string of header lines to be inserted in outgoing mails."
1018   :group 'message-headers
1019   :group 'message-mail
1020   :link '(custom-manual "(message)Mail Headers")
1021   :type 'message-header-lines)
1022
1023 (defcustom message-default-news-headers ""
1024   "*A string of header lines to be inserted in outgoing news articles."
1025   :group 'message-headers
1026   :group 'message-news
1027   :link '(custom-manual "(message)News Headers")
1028   :type 'message-header-lines)
1029
1030 ;; Note: could use /usr/ucb/mail instead of sendmail;
1031 ;; options -t, and -v if not interactive.
1032 (defcustom message-mailer-swallows-blank-line
1033   (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
1034                          system-configuration)
1035            (file-readable-p "/etc/sendmail.cf")
1036            (let ((buffer (get-buffer-create " *temp*")))
1037              (unwind-protect
1038                  (save-excursion
1039                    (set-buffer buffer)
1040                    (insert-file-contents "/etc/sendmail.cf")
1041                    (goto-char (point-min))
1042                    (let ((case-fold-search nil))
1043                      (re-search-forward "^OR\\>" nil t)))
1044                (kill-buffer buffer))))
1045       ;; According to RFC822, "The field-name must be composed of printable
1046       ;; ASCII characters (i. e., characters that have decimal values between
1047       ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
1048       ;; space, or colon.
1049       '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
1050   "*Set this non-nil if the system's mailer runs the header and body together.
1051 \(This problem exists on Sunos 4 when sendmail is run in remote mode.)
1052 The value should be an expression to test whether the problem will
1053 actually occur."
1054   :group 'message-sending
1055   :link '(custom-manual "(message)Mail Variables")
1056   :type 'sexp)
1057
1058 ;;;###autoload
1059 (define-mail-user-agent 'message-user-agent
1060   'message-mail 'message-send-and-exit
1061   'message-kill-buffer 'message-send-hook)
1062
1063 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
1064   "If non-nil, delete the deletable headers before feeding to mh.")
1065
1066 (defvar message-send-method-alist
1067   '((news message-news-p message-send-via-news)
1068     (mail message-mail-p message-send-via-mail))
1069   "Alist of ways to send outgoing messages.
1070 Each element has the form
1071
1072   \(TYPE PREDICATE FUNCTION)
1073
1074 where TYPE is a symbol that names the method; PREDICATE is a function
1075 called without any parameters to determine whether the message is
1076 a message of type TYPE; and FUNCTION is a function to be called if
1077 PREDICATE returns non-nil.  FUNCTION is called with one parameter --
1078 the prefix.")
1079
1080 (defcustom message-mail-alias-type 'abbrev
1081   "*What alias expansion type to use in Message buffers.
1082 The default is `abbrev', which uses mailabbrev.  nil switches
1083 mail aliases off."
1084   :group 'message
1085   :link '(custom-manual "(message)Mail Aliases")
1086   :type '(choice (const :tag "Use Mailabbrev" abbrev)
1087                  (const :tag "No expansion" nil)))
1088
1089 (defcustom message-auto-save-directory
1090   (file-name-as-directory (nnheader-concat message-directory "drafts"))
1091   "*Directory where Message auto-saves buffers if Gnus isn't running.
1092 If nil, Message won't auto-save."
1093   :group 'message-buffers
1094   :link '(custom-manual "(message)Various Message Variables")
1095   :type '(choice directory (const :tag "Don't auto-save" nil)))
1096
1097 (defcustom message-default-charset
1098   (and (not (mm-multibyte-p)) 'iso-8859-1)
1099   "Default charset used in non-MULE Emacsen.
1100 If nil, you might be asked to input the charset."
1101   :version "21.1"
1102   :group 'message
1103   :link '(custom-manual "(message)Various Message Variables")
1104   :type 'symbol)
1105
1106 (defcustom message-dont-reply-to-names
1107   (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
1108   "*A regexp specifying addresses to prune when doing wide replies.
1109 A value of nil means exclude your own user name only."
1110   :version "21.1"
1111   :group 'message
1112   :link '(custom-manual "(message)Wide Reply")
1113   :type '(choice (const :tag "Yourself" nil)
1114                  regexp))
1115
1116 (defvar message-shoot-gnksa-feet nil
1117   "*A list of GNKSA feet you are allowed to shoot.
1118 Gnus gives you all the opportunity you could possibly want for
1119 shooting yourself in the foot.  Also, Gnus allows you to shoot the
1120 feet of Good Net-Keeping Seal of Approval.  The following are foot
1121 candidates:
1122 `empty-article'     Allow you to post an empty article;
1123 `quoted-text-only'  Allow you to post quoted text only;
1124 `multiple-copies'   Allow you to post multiple copies;
1125 `cancel-messages'   Allow you to cancel or supersede messages from
1126                     your other email addresses.")
1127
1128 (defsubst message-gnksa-enable-p (feature)
1129   (or (not (listp message-shoot-gnksa-feet))
1130       (memq feature message-shoot-gnksa-feet)))
1131
1132 (defcustom message-hidden-headers "^References:"
1133   "Regexp of headers to be hidden when composing new messages.
1134 This can also be a list of regexps to match headers.  Or a list
1135 starting with `not' and followed by regexps."
1136   :version "22.1"
1137   :group 'message
1138   :link '(custom-manual "(message)Message Headers")
1139   :type '(choice
1140           :format "%{%t%}: %[Value Type%] %v"
1141           (regexp :menu-tag "regexp" :format "regexp\n%t: %v")
1142           (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i"
1143                   (regexp :format "%t: %v"))
1144           (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v"
1145                 (const not)
1146                 (repeat :format "%v%i"
1147                         (regexp :format "%t: %v")))))
1148
1149 (defcustom message-cite-articles-with-x-no-archive t
1150   "If non-nil, cite text from articles that has X-No-Archive set."
1151   :group 'message
1152   :type 'boolean)
1153
1154 ;;; Internal variables.
1155 ;;; Well, not really internal.
1156
1157 (defvar message-mode-syntax-table
1158   (let ((table (copy-syntax-table text-mode-syntax-table)))
1159     (modify-syntax-entry ?% ". " table)
1160     (modify-syntax-entry ?> ". " table)
1161     (modify-syntax-entry ?< ". " table)
1162     table)
1163   "Syntax table used while in Message mode.")
1164
1165 (defface message-header-to
1166   '((((class color)
1167       (background dark))
1168      (:foreground "green2" :bold t))
1169     (((class color)
1170       (background light))
1171      (:foreground "MidnightBlue" :bold t))
1172     (t
1173      (:bold t :italic t)))
1174   "Face used for displaying From headers."
1175   :group 'message-faces)
1176 ;; backward-compatibility alias
1177 (put 'message-header-to-face 'face-alias 'message-header-to)
1178
1179 (defface message-header-cc
1180   '((((class color)
1181       (background dark))
1182      (:foreground "green4" :bold t))
1183     (((class color)
1184       (background light))
1185      (:foreground "MidnightBlue"))
1186     (t
1187      (:bold t)))
1188   "Face used for displaying Cc headers."
1189   :group 'message-faces)
1190 ;; backward-compatibility alias
1191 (put 'message-header-cc-face 'face-alias 'message-header-cc)
1192
1193 (defface message-header-subject
1194   '((((class color)
1195       (background dark))
1196      (:foreground "green3"))
1197     (((class color)
1198       (background light))
1199      (:foreground "navy blue" :bold t))
1200     (t
1201      (:bold t)))
1202   "Face used for displaying subject headers."
1203   :group 'message-faces)
1204 ;; backward-compatibility alias
1205 (put 'message-header-subject-face 'face-alias 'message-header-subject)
1206
1207 (defface message-header-newsgroups
1208   '((((class color)
1209       (background dark))
1210      (:foreground "yellow" :bold t :italic t))
1211     (((class color)
1212       (background light))
1213      (:foreground "blue4" :bold t :italic t))
1214     (t
1215      (:bold t :italic t)))
1216   "Face used for displaying newsgroups headers."
1217   :group 'message-faces)
1218 ;; backward-compatibility alias
1219 (put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
1220
1221 (defface message-header-other
1222   '((((class color)
1223       (background dark))
1224      (:foreground "#b00000"))
1225     (((class color)
1226       (background light))
1227      (:foreground "steel blue"))
1228     (t
1229      (:bold t :italic t)))
1230   "Face used for displaying newsgroups headers."
1231   :group 'message-faces)
1232 ;; backward-compatibility alias
1233 (put 'message-header-other-face 'face-alias 'message-header-other)
1234
1235 (defface message-header-name
1236   '((((class color)
1237       (background dark))
1238      (:foreground "DarkGreen"))
1239     (((class color)
1240       (background light))
1241      (:foreground "cornflower blue"))
1242     (t
1243      (:bold t)))
1244   "Face used for displaying header names."
1245   :group 'message-faces)
1246 ;; backward-compatibility alias
1247 (put 'message-header-name-face 'face-alias 'message-header-name)
1248
1249 (defface message-header-xheader
1250   '((((class color)
1251       (background dark))
1252      (:foreground "blue"))
1253     (((class color)
1254       (background light))
1255      (:foreground "blue"))
1256     (t
1257      (:bold t)))
1258   "Face used for displaying X-Header headers."
1259   :group 'message-faces)
1260 ;; backward-compatibility alias
1261 (put 'message-header-xheader-face 'face-alias 'message-header-xheader)
1262
1263 (defface message-separator
1264   '((((class color)
1265       (background dark))
1266      (:foreground "blue3"))
1267     (((class color)
1268       (background light))
1269      (:foreground "brown"))
1270     (t
1271      (:bold t)))
1272   "Face used for displaying the separator."
1273   :group 'message-faces)
1274 ;; backward-compatibility alias
1275 (put 'message-separator-face 'face-alias 'message-separator)
1276
1277 (defface message-cited-text
1278   '((((class color)
1279       (background dark))
1280      (:foreground "red"))
1281     (((class color)
1282       (background light))
1283      (:foreground "red"))
1284     (t
1285      (:bold t)))
1286   "Face used for displaying cited text names."
1287   :group 'message-faces)
1288 ;; backward-compatibility alias
1289 (put 'message-cited-text-face 'face-alias 'message-cited-text)
1290
1291 (defface message-mml
1292   '((((class color)
1293       (background dark))
1294      (:foreground "ForestGreen"))
1295     (((class color)
1296       (background light))
1297      (:foreground "ForestGreen"))
1298     (t
1299      (:bold t)))
1300   "Face used for displaying MML."
1301   :group 'message-faces)
1302 ;; backward-compatibility alias
1303 (put 'message-mml-face 'face-alias 'message-mml)
1304
1305 (defun message-font-lock-make-header-matcher (regexp)
1306   (let ((form
1307          `(lambda (limit)
1308             (let ((start (point)))
1309               (save-restriction
1310                 (widen)
1311                 (goto-char (point-min))
1312                 (if (re-search-forward
1313                      (concat "^" (regexp-quote mail-header-separator) "$")
1314                      nil t)
1315                     (setq limit (min limit (match-beginning 0))))
1316                 (goto-char start))
1317               (and (< start limit)
1318                    (re-search-forward ,regexp limit t))))))
1319     (if (featurep 'bytecomp)
1320         (byte-compile form)
1321       form)))
1322
1323 (defvar message-font-lock-keywords
1324   (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
1325     `((,(message-font-lock-make-header-matcher
1326          (concat "^\\([Tt]o:\\)" content))
1327        (1 'message-header-name)
1328        (2 'message-header-to nil t))
1329       (,(message-font-lock-make-header-matcher
1330          (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
1331        (1 'message-header-name)
1332        (2 'message-header-cc nil t))
1333       (,(message-font-lock-make-header-matcher
1334          (concat "^\\([Ss]ubject:\\)" content))
1335        (1 'message-header-name)
1336        (2 'message-header-subject nil t))
1337       (,(message-font-lock-make-header-matcher
1338          (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
1339        (1 'message-header-name)
1340        (2 'message-header-newsgroups nil t))
1341       (,(message-font-lock-make-header-matcher
1342          (concat "^\\([A-Z][^: \n\t]+:\\)" content))
1343        (1 'message-header-name)
1344        (2 'message-header-other nil t))
1345       (,(message-font-lock-make-header-matcher
1346          (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
1347        (1 'message-header-name)
1348        (2 'message-header-name))
1349       ,@(if (and mail-header-separator
1350                  (not (equal mail-header-separator "")))
1351             `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1352                1 'message-separator))
1353           nil)
1354       ((lambda (limit)
1355          (re-search-forward (concat "^\\("
1356                                     message-cite-prefix-regexp
1357                                     "\\).*")
1358                             limit t))
1359        (0 'message-cited-text))
1360       ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
1361        (0 'message-mml))))
1362   "Additional expressions to highlight in Message mode.")
1363
1364
1365 ;; XEmacs does it like this.  For Emacs, we have to set the
1366 ;; `font-lock-defaults' buffer-local variable.
1367 (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
1368
1369 (defvar message-face-alist
1370   '((bold . message-bold-region)
1371     (underline . underline-region)
1372     (default . (lambda (b e)
1373                  (message-unbold-region b e)
1374                  (ununderline-region b e))))
1375   "Alist of mail and news faces for facemenu.
1376 The cdr of each entry is a function for applying the face to a region.")
1377
1378 (defcustom message-send-hook nil
1379   "Hook run before sending messages.
1380 This hook is run quite early when sending."
1381   :group 'message-various
1382   :options '(ispell-message)
1383   :link '(custom-manual "(message)Various Message Variables")
1384   :type 'hook)
1385
1386 (defcustom message-send-mail-hook nil
1387   "Hook run before sending mail messages.
1388 This hook is run very late -- just before the message is sent as
1389 mail."
1390   :group 'message-various
1391   :link '(custom-manual "(message)Various Message Variables")
1392   :type 'hook)
1393
1394 (defcustom message-send-news-hook nil
1395   "Hook run before sending news messages.
1396 This hook is run very late -- just before the message is sent as
1397 news."
1398   :group 'message-various
1399   :link '(custom-manual "(message)Various Message Variables")
1400   :type 'hook)
1401
1402 (defcustom message-sent-hook nil
1403   "Hook run after sending messages."
1404   :group 'message-various
1405   :type 'hook)
1406
1407 (defvar message-send-coding-system 'binary
1408   "Coding system to encode outgoing mail.")
1409
1410 (defvar message-draft-coding-system
1411   mm-auto-save-coding-system
1412   "*Coding system to compose mail.
1413 If you'd like to make it possible to share draft files between XEmacs
1414 and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
1415 Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
1416
1417 (defcustom message-send-mail-partially-limit 1000000
1418   "The limitation of messages sent as message/partial.
1419 The lower bound of message size in characters, beyond which the message
1420 should be sent in several parts.  If it is nil, the size is unlimited."
1421   :version "21.1"
1422   :group 'message-buffers
1423   :link '(custom-manual "(message)Mail Variables")
1424   :type '(choice (const :tag "unlimited" nil)
1425                  (integer 1000000)))
1426
1427 (defcustom message-alternative-emails nil
1428   "*Regexp matching alternative email addresses.
1429 The first address in the To, Cc or From headers of the original
1430 article matching this variable is used as the From field of
1431 outgoing messages.
1432
1433 This variable has precedence over posting styles and anything that runs
1434 off `message-setup-hook'."
1435   :group 'message-headers
1436   :link '(custom-manual "(message)Message Headers")
1437   :type '(choice (const :tag "Always use primary" nil)
1438                  regexp))
1439
1440 (defcustom message-hierarchical-addresses nil
1441   "A list of hierarchical mail address definitions.
1442
1443 Inside each entry, the first address is the \"top\" address, and
1444 subsequent addresses are subaddresses; this is used to indicate that
1445 mail sent to the first address will automatically be delivered to the
1446 subaddresses.  So if the first address appears in the recipient list
1447 for a message, the subaddresses will be removed (if present) before
1448 the mail is sent.  All addresses in this structure should be
1449 downcased."
1450   :version "22.1"
1451   :group 'message-headers
1452   :type '(repeat (repeat string)))
1453
1454 (defcustom message-mail-user-agent nil
1455   "Like `mail-user-agent'.
1456 Except if it is nil, use Gnus native MUA; if it is t, use
1457 `mail-user-agent'."
1458   :version "22.1"
1459   :type '(radio (const :tag "Gnus native"
1460                        :format "%t\n"
1461                        nil)
1462                 (const :tag "`mail-user-agent'"
1463                        :format "%t\n"
1464                        t)
1465                 (function-item :tag "Default Emacs mail"
1466                                :format "%t\n"
1467                                sendmail-user-agent)
1468                 (function-item :tag "Emacs interface to MH"
1469                                :format "%t\n"
1470                                mh-e-user-agent)
1471                 (function :tag "Other"))
1472   :version "21.1"
1473   :group 'message)
1474
1475 (defcustom message-wide-reply-confirm-recipients nil
1476   "Whether to confirm a wide reply to multiple email recipients.
1477 If this variable is nil, don't ask whether to reply to all recipients.
1478 If this variable is non-nil, pose the question \"Reply to all
1479 recipients?\" before a wide reply to multiple recipients.  If the user
1480 answers yes, reply to all recipients as usual.  If the user answers
1481 no, only reply back to the author."
1482   :version "22.1"
1483   :group 'message-headers
1484   :link '(custom-manual "(message)Wide Reply")
1485   :type 'boolean)
1486
1487 (defcustom message-user-fqdn nil
1488   "*Domain part of Message-Ids."
1489   :version "22.1"
1490   :group 'message-headers
1491   :link '(custom-manual "(message)News Headers")
1492   :type '(radio (const :format "%v  " nil)
1493                 (string :format "FQDN: %v")))
1494
1495 (defcustom message-use-idna (and (condition-case nil (require 'idna)
1496                                    (file-error))
1497                                  (mm-coding-system-p 'utf-8)
1498                                  (executable-find idna-program)
1499                                  (string= (idna-to-ascii "räksmörgås")
1500                                           "xn--rksmrgs-5wao1o")
1501                                  t)
1502   "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
1503 GNU Libidn, and in particular the elisp package \"idna.el\" and
1504 the external program \"idn\", must be installed for this
1505 functionality to work."
1506   :version "22.1"
1507   :group 'message-headers
1508   :link '(custom-manual "(message)IDNA")
1509   :type '(choice (const :tag "Ask" ask)
1510                  (const :tag "Never" nil)
1511                  (const :tag "Always" t)))
1512
1513 (defcustom message-generate-hashcash nil
1514   "*Whether to generate X-Hashcash: headers.
1515 You must have the \"hashcash\" binary installed, see `hashcash-path'."
1516   :group 'message-headers
1517   :link '(custom-manual "(message)Mail Headers")
1518   :type 'boolean)
1519
1520 ;;; Internal variables.
1521
1522 (defvar message-sending-message "Sending...")
1523 (defvar message-buffer-list nil)
1524 (defvar message-this-is-news nil)
1525 (defvar message-this-is-mail nil)
1526 (defvar message-draft-article nil)
1527 (defvar message-mime-part nil)
1528 (defvar message-posting-charset nil)
1529 (defvar message-inserted-headers nil)
1530
1531 ;; Byte-compiler warning
1532 (eval-when-compile
1533   (defvar gnus-active-hashtb)
1534   (defvar gnus-read-active-file))
1535
1536 ;;; Regexp matching the delimiter of messages in UNIX mail format
1537 ;;; (UNIX From lines), minus the initial ^.  It should be a copy
1538 ;;; of rmail.el's rmail-unix-mail-delimiter.
1539 (defvar message-unix-mail-delimiter
1540   (let ((time-zone-regexp
1541          (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
1542                  "\\|[-+]?[0-9][0-9][0-9][0-9]"
1543                  "\\|"
1544                  "\\) *")))
1545     (concat
1546      "From "
1547
1548      ;; Many things can happen to an RFC 822 mailbox before it is put into
1549      ;; a `From' line.  The leading phrase can be stripped, e.g.
1550      ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'.  The <> can be stripped, e.g.
1551      ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'.  Everything starting with a CRLF
1552      ;; can be removed, e.g.
1553      ;;         From: joe@y.z (Joe      K
1554      ;;                 User)
1555      ;; can yield `From joe@y.z (Joe    K Fri Mar 22 08:11:15 1996', and
1556      ;;         From: Joe User
1557      ;;                 <joe@y.z>
1558      ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
1559      ;; The mailbox can be removed or be replaced by white space, e.g.
1560      ;;         From: "Joe User"{space}{tab}
1561      ;;                 <joe@y.z>
1562      ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
1563      ;; where {space} and {tab} represent the Ascii space and tab characters.
1564      ;; We want to match the results of any of these manglings.
1565      ;; The following regexp rejects names whose first characters are
1566      ;; obviously bogus, but after that anything goes.
1567      "\\([^\0-\b\n-\r\^?].*\\)?"
1568
1569      ;; The time the message was sent.
1570      "\\([^\0-\r \^?]+\\) +"            ; day of the week
1571      "\\([^\0-\r \^?]+\\) +"            ; month
1572      "\\([0-3]?[0-9]\\) +"              ; day of month
1573      "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
1574
1575      ;; Perhaps a time zone, specified by an abbreviation, or by a
1576      ;; numeric offset.
1577      time-zone-regexp
1578
1579      ;; The year.
1580      " \\([0-9][0-9]+\\) *"
1581
1582      ;; On some systems the time zone can appear after the year, too.
1583      time-zone-regexp
1584
1585      ;; Old uucp cruft.
1586      "\\(remote from .*\\)?"
1587
1588      "\n"))
1589   "Regexp matching the delimiter of messages in UNIX mail format.")
1590
1591 (defvar message-unsent-separator
1592   (concat "^ *---+ +Unsent message follows +---+ *$\\|"
1593           "^ *---+ +Returned message +---+ *$\\|"
1594           "^Start of returned message$\\|"
1595           "^ *---+ +Original message +---+ *$\\|"
1596           "^ *--+ +begin message +--+ *$\\|"
1597           "^ *---+ +Original message follows +---+ *$\\|"
1598           "^ *---+ +Undelivered message follows +---+ *$\\|"
1599           "^|? *---+ +Message text follows: +---+ *|?$")
1600   "A regexp that matches the separator before the text of a failed message.")
1601
1602 (defvar message-field-fillers
1603   '((To message-fill-field-address)
1604     (Cc message-fill-field-address)
1605     (From message-fill-field-address))
1606   "Alist of header names/filler functions.")
1607
1608 (defvar message-header-format-alist
1609   `((From)
1610     (Newsgroups)
1611     (To)
1612     (Cc)
1613     (Subject)
1614     (In-Reply-To)
1615     (Fcc)
1616     (Bcc)
1617     (Date)
1618     (Organization)
1619     (Distribution)
1620     (Lines)
1621     (Expires)
1622     (Message-ID)
1623     (References . message-shorten-references)
1624     (User-Agent))
1625   "Alist used for formatting headers.")
1626
1627 (defvar message-options nil
1628   "Some saved answers when sending message.")
1629
1630 (defvar message-send-mail-real-function nil
1631   "Internal send mail function.")
1632
1633 (defvar message-bogus-system-names "^localhost\\."
1634   "The regexp of bogus system names.")
1635
1636 (defcustom message-valid-fqdn-regexp
1637   (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
1638           ;; valid TLDs:
1639           "\\([a-z][a-z]" ;; two letter country TDLs
1640           "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
1641           "\\|aero\\|coop\\|info\\|name\\|museum"
1642           "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
1643           "\\)")
1644   "Regular expression that matches a valid FQDN."
1645   ;; see also: gnus-button-valid-fqdn-regexp
1646   :version "22.1"
1647   :group 'message-headers
1648   :type 'regexp)
1649
1650 (eval-and-compile
1651   (autoload 'gnus-alive-p "gnus-util")
1652   (autoload 'gnus-delay-article "gnus-delay")
1653   (autoload 'gnus-extract-address-components "gnus-util")
1654   (autoload 'gnus-find-method-for-group "gnus")
1655   (autoload 'gnus-group-decoded-name "gnus-group")
1656   (autoload 'gnus-group-name-charset "gnus-group")
1657   (autoload 'gnus-group-name-decode "gnus-group")
1658   (autoload 'gnus-groups-from-server "gnus")
1659   (autoload 'gnus-make-local-hook "gnus-util")
1660   (autoload 'gnus-open-server "gnus-int")
1661   (autoload 'gnus-output-to-mail "gnus-util")
1662   (autoload 'gnus-output-to-rmail "gnus-util")
1663   (autoload 'gnus-request-post "gnus-int")
1664   (autoload 'gnus-server-string "gnus")
1665   (autoload 'idna-to-ascii "idna")
1666   (autoload 'message-setup-toolbar "messagexmas")
1667   (autoload 'mh-new-draft-name "mh-comp")
1668   (autoload 'mh-send-letter "mh-comp")
1669   (autoload 'nndraft-request-associate-buffer "nndraft")
1670   (autoload 'nndraft-request-expire-articles "nndraft")
1671   (autoload 'nnvirtual-find-group-art "nnvirtual")
1672   (autoload 'rmail-dont-reply-to "mail-utils")
1673   (autoload 'rmail-msg-is-pruned "rmail")
1674   (autoload 'rmail-msg-restore-non-pruned-header "rmail")
1675   (autoload 'rmail-output "rmailout"))
1676
1677 \f
1678
1679 ;;;
1680 ;;; Utility functions.
1681 ;;;
1682
1683 (defmacro message-y-or-n-p (question show &rest text)
1684   "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW."
1685   `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
1686
1687 (defmacro message-delete-line (&optional n)
1688   "Delete the current line (and the next N lines)."
1689   `(delete-region (progn (beginning-of-line) (point))
1690                   (progn (forward-line ,(or n 1)) (point))))
1691
1692 (defun message-mark-active-p ()
1693   "Non-nil means the mark and region are currently active in this buffer."
1694   mark-active)
1695
1696 (defun message-unquote-tokens (elems)
1697   "Remove double quotes (\") from strings in list ELEMS."
1698   (mapcar (lambda (item)
1699             (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
1700               (setq item (concat (match-string 1 item)
1701                                  (match-string 2 item))))
1702             item)
1703           elems))
1704
1705 (defun message-tokenize-header (header &optional separator)
1706   "Split HEADER into a list of header elements.
1707 SEPARATOR is a string of characters to be used as separators.  \",\"
1708 is used by default."
1709   (if&nbs