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

   1 ;;; message.el --- composing mail and news messages
   2 ;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: mail, news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This mode provides mail-sending facilities from within Emacs.  It
  27 ;; consists mainly of large chunks of code from the sendmail.el,
  28 ;; gnus-msg.el and rnewspost.el files.
  29
  30 ;;; Code:
  31
  32 (eval-when-compile (require 'cl))
  33
  34 (require 'mailheader)
  35 (require 'nnheader)
  36 (require 'easymenu)
  37 (require 'custom)
  38 (if (string-match "XEmacs\\|Lucid" emacs-version)
  39     (require 'mail-abbrevs)
  40   (require 'mailabbrev))
  41 (require 'mail-parse)
  42 (require 'mm-bodies)
  43 (require 'mm-encode)
  44 (require 'mml)
  45
  46 (defgroup message '((user-mail-address custom-variable)
  47                     (user-full-name custom-variable))
  48   "Mail and news message composing."
  49   :link '(custom-manual "(message)Top")
  50   :group 'mail
  51   :group 'news)
  52
  53 (put 'user-mail-address 'custom-type 'string)
  54 (put 'user-full-name 'custom-type 'string)
  55
  56 (defgroup message-various nil
  57   "Various Message Variables"
  58   :link '(custom-manual "(message)Various Message Variables")
  59   :group 'message)
  60
  61 (defgroup message-buffers nil
  62   "Message Buffers"
  63   :link '(custom-manual "(message)Message Buffers")
  64   :group 'message)
  65
  66 (defgroup message-sending nil
  67   "Message Sending"
  68   :link '(custom-manual "(message)Sending Variables")
  69   :group 'message)
  70
  71 (defgroup message-interface nil
  72   "Message Interface"
  73   :link '(custom-manual "(message)Interface")
  74   :group 'message)
  75
  76 (defgroup message-forwarding nil
  77   "Message Forwarding"
  78   :link '(custom-manual "(message)Forwarding")
  79   :group 'message-interface)
  80
  81 (defgroup message-insertion nil
  82   "Message Insertion"
  83   :link '(custom-manual "(message)Insertion")
  84   :group 'message)
  85
  86 (defgroup message-headers nil
  87   "Message Headers"
  88   :link '(custom-manual "(message)Message Headers")
  89   :group 'message)
  90
  91 (defgroup message-news nil
  92   "Composing News Messages"
  93   :group 'message)
  94
  95 (defgroup message-mail nil
  96   "Composing Mail Messages"
  97   :group 'message)
  98
  99 (defgroup message-faces nil
 100   "Faces used for message composing."
 101   :group 'message
 102   :group 'faces)
 103
 104 (defcustom message-directory "~/Mail/"
 105   "*Directory from which all other mail file variables are derived."
 106   :group 'message-various
 107   :type 'directory)
 108
 109 (defcustom message-max-buffers 10
 110   "*How many buffers to keep before starting to kill them off."
 111   :group 'message-buffers
 112   :type 'integer)
 113
 114 (defcustom message-send-rename-function nil
 115   "Function called to rename the buffer after sending it."
 116   :group 'message-buffers
 117   :type 'function)
 118
 119 (defcustom message-fcc-handler-function 'message-output
 120   "*A function called to save outgoing articles.
 121 This function will be called with the name of the file to store the
 122 article in.  The default function is `message-output' which saves in Unix
 123 mailbox format."
 124   :type '(radio (function-item message-output)
 125                 (function :tag "Other"))
 126   :group 'message-sending)
 127
 128 (defcustom message-courtesy-message
 129   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 130   "*This is inserted at the start of a mailed copy of a posted message.
 131 If the string contains the format spec \"%s\", the Newsgroups
 132 the article has been posted to will be inserted there.
 133 If this variable is nil, no such courtesy message will be added."
 134   :group 'message-sending
 135   :type 'string)
 136
 137 (defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
 138   "*Regexp that matches headers to be removed in resent bounced mail."
 139   :group 'message-interface
 140   :type 'regexp)
 141
 142 ;;;###autoload
 143 (defcustom message-from-style 'default
 144   "*Specifies how \"From\" headers look.
 145
 146 If `nil', they contain just the return address like:
 147         king@grassland.com
 148 If `parens', they look like:
 149         king@grassland.com (Elvis Parsley)
 150 If `angles', they look like:
 151         Elvis Parsley <king@grassland.com>
 152
 153 Otherwise, most addresses look like `angles', but they look like
 154 `parens' if `angles' would need quoting and `parens' would not."
 155   :type '(choice (const :tag "simple" nil)
 156                  (const parens)
 157                  (const angles)
 158                  (const default))
 159   :group 'message-headers)
 160
 161 (defcustom message-syntax-checks nil
 162   ; Guess this one shouldn't be easy to customize...
 163   "*Controls what syntax checks should not be performed on outgoing posts.
 164 To disable checking of long signatures, for instance, add
 165  `(signature . disabled)' to this list.
 166
 167 Don't touch this variable unless you really know what you're doing.
 168
 169 Checks include subject-cmsg multiple-headers sendsys message-id from
 170 long-lines control-chars size new-text redirected-followup signature
 171 approved sender empty empty-headers message-id from subject
 172 shorten-followup-to existing-newsgroups buffer-file-name unchanged
 173 newsgroups."
 174   :group 'message-news)
 175
 176 (defcustom message-required-news-headers
 177   '(From Newsgroups Subject Date Message-ID
 178          (optional . Organization) Lines
 179          (optional . User-Agent))
 180   "*Headers to be generated or prompted for when posting an article.
 181 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 182 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 183 User-Agent are optional.  If don't you want message to insert some
 184 header, remove it from this list."
 185   :group 'message-news
 186   :group 'message-headers
 187   :type '(repeat sexp))
 188
 189 (defcustom message-required-mail-headers
 190   '(From Subject Date (optional . In-Reply-To) Message-ID Lines
 191          (optional . User-Agent))
 192   "*Headers to be generated or prompted for when mailing a message.
 193 RFC822 required that From, Date, To, Subject and Message-ID be
 194 included.  Organization, Lines and User-Agent are optional."
 195   :group 'message-mail
 196   :group 'message-headers
 197   :type '(repeat sexp))
 198
 199 (defcustom message-deletable-headers '(Message-ID Date Lines)
 200   "Headers to be deleted if they already exist and were generated by message previously."
 201   :group 'message-headers
 202   :type 'sexp)
 203
 204 (defcustom message-ignored-news-headers
 205   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:"
 206   "*Regexp of headers to be removed unconditionally before posting."
 207   :group 'message-news
 208   :group 'message-headers
 209   :type 'regexp)
 210
 211 (defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:"
 212   "*Regexp of headers to be removed unconditionally before mailing."
 213   :group 'message-mail
 214   :group 'message-headers
 215   :type 'regexp)
 216
 217 (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:"
 218   "*Header lines matching this regexp will be deleted before posting.
 219 It's best to delete old Path and Date headers before posting to avoid
 220 any confusion."
 221   :group 'message-interface
 222   :type 'regexp)
 223
 224 (defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
 225   "*Regexp matching \"Re: \" in the subject line."
 226   :group 'message-various
 227   :type 'regexp)
 228
 229 ;;;###autoload
 230 (defcustom message-signature-separator "^-- *$"
 231   "Regexp matching the signature separator."
 232   :type 'regexp
 233   :group 'message-various)
 234
 235 (defcustom message-elide-ellipsis "\n[...]\n\n"
 236   "*The string which is inserted for elided text."
 237   :type 'string
 238   :group 'message-various)
 239
 240 (defcustom message-interactive nil
 241   "Non-nil means when sending a message wait for and display errors.
 242 nil means let mailer mail back a message to report errors."
 243   :group 'message-sending
 244   :group 'message-mail
 245   :type 'boolean)
 246
 247 (defcustom message-generate-new-buffers 'unique
 248   "*Non-nil means that a new message buffer will be created whenever `message-setup' is called.
 249 If this is a function, call that function with three parameters:  The type,
 250 the to address and the group name.  (Any of these may be nil.)  The function
 251 should return the new buffer name."
 252   :group 'message-buffers
 253   :type '(choice (const :tag "off" nil)
 254                  (const :tag "unique" unique)
 255                  (const :tag "unsent" unsent)
 256                  (function fun)))
 257
 258 (defcustom message-kill-buffer-on-exit nil
 259   "*Non-nil means that the message buffer will be killed after sending a message."
 260   :group 'message-buffers
 261   :type 'boolean)
 262
 263 (defvar gnus-local-organization)
 264 (defcustom message-user-organization
 265   (or (and (boundp 'gnus-local-organization)
 266            (stringp gnus-local-organization)
 267            gnus-local-organization)
 268       (getenv "ORGANIZATION")
 269       t)
 270   "*String to be used as an Organization header.
 271 If t, use `message-user-organization-file'."
 272   :group 'message-headers
 273   :type '(choice string
 274                  (const :tag "consult file" t)))
 275
 276 ;;;###autoload
 277 (defcustom message-user-organization-file "/usr/lib/news/organization"
 278   "*Local news organization file."
 279   :type 'file
 280   :group 'message-headers)
 281
 282 (defcustom message-make-forward-subject-function
 283   'message-forward-subject-author-subject
 284  "*A list of functions that are called to generate a subject header for forwarded messages.
 285 The subject generated by the previous function is passed into each
 286 successive function.
 287
 288 The provided functions are:
 289
 290 * message-forward-subject-author-subject (Source of article (author or
 291       newsgroup)), in brackets followed by the subject
 292 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
 293       to it."
 294  :group 'message-forwarding
 295  :type '(radio (function-item message-forward-subject-author-subject)
 296                (function-item message-forward-subject-fwd)))
 297
 298 (defcustom message-forward-as-mime t
 299   "*If non-nil, forward messages as an inline/rfc822 MIME section.  Otherwise, directly inline the old message in the forwarded message."
 300   :group 'message-forwarding
 301   :type 'boolean)
 302
 303 (defcustom message-wash-forwarded-subjects nil
 304   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
 305   :group 'message-forwarding
 306   :type 'boolean)
 307
 308 (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
 309   "*All headers that match this regexp will be deleted when resending a message."
 310   :group 'message-interface
 311   :type 'regexp)
 312
 313 (defcustom message-forward-ignored-headers nil
 314   "*All headers that match this regexp will be deleted when forwarding a message."
 315   :group 'message-forwarding
 316   :type '(choice (const :tag "None" nil)
 317                  regexp))
 318
 319 (defcustom message-ignored-cited-headers "."
 320   "*Delete these headers from the messages you yank."
 321   :group 'message-insertion
 322   :type 'regexp)
 323
 324 (defcustom message-cancel-message "I am canceling my own article."
 325   "Message to be inserted in the cancel message."
 326   :group 'message-interface
 327   :type 'string)
 328
 329 ;; Useful to set in site-init.el
 330 ;;;###autoload
 331 (defcustom message-send-mail-function 'message-send-mail-with-sendmail
 332   "Function to call to send the current buffer as mail.
 333 The headers should be delimited by a line whose contents match the
 334 variable `mail-header-separator'.
 335
 336 Valid values include `message-send-mail-with-sendmail' (the default),
 337 `message-send-mail-with-mh', `message-send-mail-with-qmail' and
 338 `smtpmail-send-it'."
 339   :type '(radio (function-item message-send-mail-with-sendmail)
 340                 (function-item message-send-mail-with-mh)
 341                 (function-item message-send-mail-with-qmail)
 342                 (function-item smtpmail-send-it)
 343                 (function :tag "Other"))
 344   :group 'message-sending
 345   :group 'message-mail)
 346
 347 (defcustom message-send-news-function 'message-send-news
 348   "Function to call to send the current buffer as news.
 349 The headers should be delimited by a line whose contents match the
 350 variable `mail-header-separator'."
 351   :group 'message-sending
 352   :group 'message-news
 353   :type 'function)
 354
 355 (defcustom message-reply-to-function nil
 356   "Function that should return a list of headers.
 357 This function should pick out addresses from the To, Cc, and From headers
 358 and respond with new To and Cc headers."
 359   :group 'message-interface
 360   :type 'function)
 361
 362 (defcustom message-wide-reply-to-function nil
 363   "Function that should return a list of headers.
 364 This function should pick out addresses from the To, Cc, and From headers
 365 and respond with new To and Cc headers."
 366   :group 'message-interface
 367   :type 'function)
 368
 369 (defcustom message-followup-to-function nil
 370   "Function that should return a list of headers.
 371 This function should pick out addresses from the To, Cc, and From headers
 372 and respond with new To and Cc headers."
 373   :group 'message-interface
 374   :type 'function)
 375
 376 (defcustom message-use-followup-to 'ask
 377   "*Specifies what to do with Followup-To header.
 378 If nil, always ignore the header.  If it is t, use its value, but
 379 query before using the \"poster\" value.  If it is the symbol `ask',
 380 always query the user whether to use the value.  If it is the symbol
 381 `use', always use the value."
 382   :group 'message-interface
 383   :type '(choice (const :tag "ignore" nil)
 384                  (const use)
 385                  (const ask)))
 386
 387 ;; stuff relating to broken sendmail in MMDF
 388 (defcustom message-sendmail-f-is-evil nil
 389   "*Non-nil means that \"-f username\" should not be added to the sendmail
 390 command line, because it is even more evil than leaving it out."
 391   :group 'message-sending
 392   :type 'boolean)
 393
 394 ;; qmail-related stuff
 395 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
 396   "Location of the qmail-inject program."
 397   :group 'message-sending
 398   :type 'file)
 399
 400 (defcustom message-qmail-inject-args nil
 401   "Arguments passed to qmail-inject programs.
 402 This should be a list of strings, one string for each argument.
 403
 404 For e.g., if you wish to set the envelope sender address so that bounces
 405 go to the right place or to deal with listserv's usage of that address, you
 406 might set this variable to '(\"-f\" \"you@some.where\")."
 407   :group 'message-sending
 408   :type '(repeat string))
 409
 410 (defvar message-cater-to-broken-inn t
 411   "Non-nil means Gnus should not fold the `References' header.
 412 Folding `References' makes ancient versions of INN create incorrect
 413 NOV lines.")
 414
 415 (defvar gnus-post-method)
 416 (defvar gnus-select-method)
 417 (defcustom message-post-method
 418   (cond ((and (boundp 'gnus-post-method)
 419               (listp gnus-post-method)
 420               gnus-post-method)
 421          gnus-post-method)
 422         ((boundp 'gnus-select-method)
 423          gnus-select-method)
 424         (t '(nnspool "")))
 425   "*Method used to post news.
 426 Note that when posting from inside Gnus, for instance, this
 427 variable isn't used."
 428   :group 'message-news
 429   :group 'message-sending
 430   ;; This should be the `gnus-select-method' widget, but that might
 431   ;; create a dependence to `gnus.el'.
 432   :type 'sexp)
 433
 434 (defcustom message-generate-headers-first nil
 435   "*If non-nil, generate all possible headers before composing."
 436   :group 'message-headers
 437   :type 'boolean)
 438
 439 (defcustom message-setup-hook nil
 440   "Normal hook, run each time a new outgoing message is initialized.
 441 The function `message-setup' runs this hook."
 442   :group 'message-various
 443   :type 'hook)
 444
 445 (defcustom message-cancel-hook nil
 446   "Hook run when cancelling articles."
 447   :group 'message-various
 448   :type 'hook)
 449
 450 (defcustom message-signature-setup-hook nil
 451   "Normal hook, run each time a new outgoing message is initialized.
 452 It is run after the headers have been inserted and before
 453 the signature is inserted."
 454   :group 'message-various
 455   :type 'hook)
 456
 457 (defcustom message-mode-hook nil
 458   "Hook run in message mode buffers."
 459   :group 'message-various
 460   :type 'hook)
 461
 462 (defcustom message-header-hook nil
 463   "Hook run in a message mode buffer narrowed to the headers."
 464   :group 'message-various
 465   :type 'hook)
 466
 467 (defcustom message-header-setup-hook nil
 468   "Hook called narrowed to the headers when setting up a message buffer."
 469   :group 'message-various
 470   :type 'hook)
 471
 472 ;;;###autoload
 473 (defcustom message-citation-line-function 'message-insert-citation-line
 474   "*Function called to insert the \"Whomever writes:\" line."
 475   :type 'function
 476   :group 'message-insertion)
 477
 478 ;;;###autoload
 479 (defcustom message-yank-prefix "> "
 480   "*Prefix inserted on the lines of yanked messages."
 481   :type 'string
 482   :group 'message-insertion)
 483
 484 (defcustom message-indentation-spaces 3
 485   "*Number of spaces to insert at the beginning of each cited line.
 486 Used by `message-yank-original' via `message-yank-cite'."
 487   :group 'message-insertion
 488   :type 'integer)
 489
 490 ;;;###autoload
 491 (defcustom message-cite-function 'message-cite-original
 492   "*Function for citing an original message.
 493 Predefined functions include `message-cite-original' and
 494 `message-cite-original-without-signature'.
 495 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
 496   :type '(radio (function-item message-cite-original)
 497                 (function-item message-cite-original-without-signature)
 498                 (function-item sc-cite-original)
 499                 (function :tag "Other"))
 500   :group 'message-insertion)
 501
 502 ;;;###autoload
 503 (defcustom message-indent-citation-function 'message-indent-citation
 504   "*Function for modifying a citation just inserted in the mail buffer.
 505 This can also be a list of functions.  Each function can find the
 506 citation between (point) and (mark t).  And each function should leave
 507 point and mark around the citation text as modified."
 508   :type 'function
 509   :group 'message-insertion)
 510
 511 (defvar message-abbrevs-loaded nil)
 512
 513 ;;;###autoload
 514 (defcustom message-signature t
 515   "*String to be inserted at the end of the message buffer.
 516 If t, the `message-signature-file' file will be inserted instead.
 517 If a function, the result from the function will be used instead.
 518 If a form, the result from the form will be used instead."
 519   :type 'sexp
 520   :group 'message-insertion)
 521
 522 ;;;###autoload
 523 (defcustom message-signature-file "~/.signature"
 524   "*File containing the text inserted at end of message buffer."
 525   :type 'file
 526   :group 'message-insertion)
 527
 528 (defcustom message-distribution-function nil
 529   "*Function called to return a Distribution header."
 530   :group 'message-news
 531   :group 'message-headers
 532   :type 'function)
 533
 534 (defcustom message-expires 14
 535   "Number of days before your article expires."
 536   :group 'message-news
 537   :group 'message-headers
 538   :link '(custom-manual "(message)News Headers")
 539   :type 'integer)
 540
 541 (defcustom message-user-path nil
 542   "If nil, use the NNTP server name in the Path header.
 543 If stringp, use this; if non-nil, use no host name (user name only)."
 544   :group 'message-news
 545   :group 'message-headers
 546   :link '(custom-manual "(message)News Headers")
 547   :type '(choice (const :tag "nntp" nil)
 548                  (string :tag "name")
 549                  (sexp :tag "none" :format "%t" t)))
 550
 551 (defvar message-reply-buffer nil)
 552 (defvar message-reply-headers nil)
 553 (defvar message-newsreader nil)
 554 (defvar message-mailer nil)
 555 (defvar message-sent-message-via nil)
 556 (defvar message-checksum nil)
 557 (defvar message-send-actions nil
 558   "A list of actions to be performed upon successful sending of a message.")
 559 (defvar message-exit-actions nil
 560   "A list of actions to be performed upon exiting after sending a message.")
 561 (defvar message-kill-actions nil
 562   "A list of actions to be performed before killing a message buffer.")
 563 (defvar message-postpone-actions nil
 564   "A list of actions to be performed after postponing a message.")
 565
 566 (define-widget 'message-header-lines 'text
 567   "All header lines must be LFD terminated."
 568   :format "%t:%n%v"
 569   :valid-regexp "^\\'"