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

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