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
   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-list-identifiers)) ; gnus-sum is required where necessary
  36 (require 'canlock)
  37 (require 'mailheader)
  38 (require 'nnheader)
  39 ;; This is apparently necessary even though things are autoloaded.
  40 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
  41 ;; require mailabbrev here.
  42 (if (featurep 'xemacs)
  43     (require 'mail-abbrevs)
  44   (require 'mailabbrev))
  45 (require 'mail-parse)
  46 (require 'mml)
  47 (require 'rfc822)
  48 (eval-and-compile
  49   (autoload 'sha1 "sha1-el"))
  50
  51 (defgroup message '((user-mail-address custom-variable)
  52                     (user-full-name custom-variable))
  53   "Mail and news message composing."
  54   :link '(custom-manual "(message)Top")
  55   :group 'mail
  56   :group 'news)
  57
  58 (put 'user-mail-address 'custom-type 'string)
  59 (put 'user-full-name 'custom-type 'string)
  60
  61 (defgroup message-various nil
  62   "Various Message Variables"
  63   :link '(custom-manual "(message)Various Message Variables")
  64   :group 'message)
  65
  66 (defgroup message-buffers nil
  67   "Message Buffers"
  68   :link '(custom-manual "(message)Message Buffers")
  69   :group 'message)
  70
  71 (defgroup message-sending nil
  72   "Message Sending"
  73   :link '(custom-manual "(message)Sending Variables")
  74   :group 'message)
  75
  76 (defgroup message-interface nil
  77   "Message Interface"
  78   :link '(custom-manual "(message)Interface")
  79   :group 'message)
  80
  81 (defgroup message-forwarding nil
  82   "Message Forwarding"
  83   :link '(custom-manual "(message)Forwarding")
  84   :group 'message-interface)
  85
  86 (defgroup message-insertion nil
  87   "Message Insertion"
  88   :link '(custom-manual "(message)Insertion")
  89   :group 'message)
  90
  91 (defgroup message-headers nil
  92   "Message Headers"
  93   :link '(custom-manual "(message)Message Headers")
  94   :group 'message)
  95
  96 (defgroup message-news nil
  97   "Composing News Messages"
  98   :group 'message)
  99
 100 (defgroup message-mail nil
 101   "Composing Mail Messages"
 102   :group 'message)
 103
 104 (defgroup message-faces nil
 105   "Faces used for message composing."
 106   :group 'message
 107   :group 'faces)
 108
 109 (defcustom message-directory "~/Mail/"
 110   "*Directory from which all other mail file variables are derived."
 111   :group 'message-various
 112   :type 'directory)
 113
 114 (defcustom message-max-buffers 10
 115   "*How many buffers to keep before starting to kill them off."
 116   :group 'message-buffers
 117   :type 'integer)
 118
 119 (defcustom message-send-rename-function nil
 120   "Function called to rename the buffer after sending it."
 121   :group 'message-buffers
 122   :type '(choice function (const nil)))
 123
 124 (defcustom message-fcc-handler-function 'message-output
 125   "*A function called to save outgoing articles.
 126 This function will be called with the name of the file to store the
 127 article in.  The default function is `message-output' which saves in Unix
 128 mailbox format."
 129   :type '(radio (function-item message-output)
 130                 (function :tag "Other"))
 131   :group 'message-sending)
 132
 133 (defcustom message-fcc-externalize-attachments nil
 134   "If non-nil, attachments are included as external parts in Fcc copies."
 135   :type 'boolean
 136   :group 'message-sending)
 137
 138 (defcustom message-courtesy-message
 139   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 140   "*This is inserted at the start of a mailed copy of a posted message.
 141 If the string contains the format spec \"%s\", the Newsgroups
 142 the article has been posted to will be inserted there.
 143 If this variable is nil, no such courtesy message will be added."
 144   :group 'message-sending
 145   :type 'string)
 146
 147 (defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
 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', and `long-header-lines'."
 193   :group 'message-news
 194   :type '(repeat sexp))                 ; Fixme: improve this
 195
 196 (defcustom message-required-headers '((optional . References)
 197                                       From)
 198   "*Headers to be generated or prompted for when sending a message.
 199 Also see `message-required-news-headers' and
 200 `message-required-mail-headers'."
 201   :group 'message-news
 202   :group 'message-headers
 203   :type '(repeat sexp))
 204
 205 (defcustom message-draft-headers '(References From)
 206   "*Headers to be generated when saving a draft message."
 207   :group 'message-news
 208   :group 'message-headers
 209   :type '(repeat sexp))
 210
 211 (defcustom message-required-news-headers
 212   '(From Newsgroups Subject Date Message-ID
 213          (optional . Organization)
 214          (optional . User-Agent))
 215   "*Headers to be generated or prompted for when posting an article.
 216 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 217 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 218 User-Agent are optional.  If don't you want message to insert some
 219 header, remove it from this list."
 220   :group 'message-news
 221   :group 'message-headers
 222   :type '(repeat sexp))
 223
 224 (defcustom message-required-mail-headers
 225   '(From Subject Date (optional . In-Reply-To) Message-ID
 226          (optional . User-Agent))
 227   "*Headers to be generated or prompted for when mailing a message.
 228 It is recommended that From, Date, To, Subject and Message-ID be
 229 included.  Organization and User-Agent are optional."
 230   :group 'message-mail
 231   :group 'message-headers
 232   :type '(repeat sexp))
 233
 234 (defcustom message-deletable-headers '(Message-ID Date Lines)
 235   "Headers to be deleted if they already exist and were generated by message previously."
 236   :group 'message-headers
 237   :type 'sexp)
 238
 239 (defcustom message-ignored-news-headers
 240   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 241   "*Regexp of headers to be removed unconditionally before posting."
 242   :group 'message-news
 243   :group 'message-headers
 244   :type 'regexp)
 245
 246 (defcustom message-ignored-mail-headers
 247   "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 248   "*Regexp of headers to be removed unconditionally before mailing."
 249   :group 'message-mail
 250   :group 'message-headers
 251   :type 'regexp)
 252
 253 (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:"
 254   "*Header lines matching this regexp will be deleted before posting.
 255 It's best to delete old Path and Date headers before posting to avoid
 256 any confusion."
 257   :group 'message-interface
 258   :type 'regexp)
 259
 260 (defcustom message-subject-re-regexp
 261   "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
 262   "*Regexp matching \"Re: \" in the subject line."
 263   :group 'message-various
 264   :type 'regexp)
 265
 266 ;;; Start of variables adopted from `message-utils.el'.
 267
 268 (defcustom message-subject-trailing-was-query 'ask
 269   ;; should it default to nil or ask?
 270   "*What to do with trailing \"(was: <old subject>)\" in subject lines.
 271 If nil, leave the subject unchanged.  If it is the symbol `ask', query
 272 the user what do do.  In this case, the subject is matched against
 273 `message-subject-trailing-was-ask-regexp'.  If
 274 `message-subject-trailing-was-query' is t, always strip the trailing
 275 old subject.  In this case, `message-subject-trailing-was-regexp' is
 276 used."
 277   :type '(choice (const :tag "never" nil)
 278                  (const :tag "always strip" t)
 279                  (const ask))
 280   :group 'message-various)
 281
 282 (defcustom message-subject-trailing-was-ask-regexp
 283   "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
 284   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 285
 286 The function `message-strip-subject-trailing-was' uses this regexp if
 287 `message-subject-trailing-was-query' is set to the symbol `ask'.  If
 288 the variable is t instead of `ask', use
 289 `message-subject-trailing-was-regexp' instead.
 290
 291 It is okay to create some false positives here, as the user is asked."
 292   :group 'message-various
 293   :type 'regexp)
 294
 295 (defcustom message-subject-trailing-was-regexp
 296   "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
 297   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 298
 299 If `message-subject-trailing-was-query' is set to t, the subject is
 300 matched against `message-subject-trailing-was-regexp' in
 301 `message-strip-subject-trailing-was'.  You should use a regexp creating very
 302 few false positives here."
 303   :group 'message-various
 304   :type 'regexp)
 305
 306 ;;; marking inserted text
 307
 308 ;;;###autoload
 309 (defcustom message-mark-insert-begin
 310   "--8<---------------cut here---------------start------------->8---\n"
 311   "How to mark the beginning of some inserted text."
 312   :type 'string
 313   :group 'message-various)
 314
 315 ;;;###autoload
 316 (defcustom message-mark-insert-end
 317   "--8<---------------cut here---------------end--------------->8---\n"
 318   "How to mark the end of some inserted text."
 319   :type 'string
 320   :group 'message-various)
 321
 322 ;;;###autoload
 323 (defcustom message-archive-header
 324   "X-No-Archive: Yes\n"
 325   "Header to insert when you don't want your article to be archived.
 326 Archives \(such as groups.googgle.com\) respect this header."
 327   :type 'string
 328   :group 'message-various)
 329
 330 ;;;###autoload
 331 (defcustom message-archive-note
 332   "X-No-Archive: Yes - save http://groups.google.com/"
 333   "Note to insert why you wouldn't want this posting archived.
 334 If nil, don't insert any text in the body."
 335   :type 'string
 336   :group 'message-various)
 337
 338 ;;; Crossposts and Followups
 339 ;; inspired by JoH-followup-to by Jochem Huhman <joh  at gmx.de>
 340 ;; new suggestions by R. Weikusat <rw at another.de>
 341
 342 (defvar message-cross-post-old-target nil
 343   "Old target for cross-posts or follow-ups.")
 344 (make-variable-buffer-local 'message-cross-post-old-target)
 345
 346 ;;;###autoload
 347 (defcustom message-cross-post-default t
 348   "When non-nil `message-cross-post-followup-to' will perform a crosspost.
 349 If nil, `message-cross-post-followup-to' will only do a followup.  Note that
 350 you can explicitly override this setting by calling
 351 `message-cross-post-followup-to' with a prefix."
 352   :type 'boolean
 353   :group 'message-various)
 354
 355 ;;;###autoload
 356 (defcustom message-cross-post-note
 357   "Crosspost & Followup-To: "
 358   "Note to insert before signature to notify of cross-post and follow-up."
 359   :type 'string
 360   :group 'message-various)
 361
 362 ;;;###autoload
 363 (defcustom message-followup-to-note
 364   "Followup-To: "
 365   "Note to insert before signature to notify of follow-up only."
 366   :type 'string
 367   :group 'message-various)
 368
 369 ;;;###autoload
 370 (defcustom message-cross-post-note-function
 371   'message-cross-post-insert-note
 372   "Function to use to insert note about Crosspost or Followup-To.
 373 The function will be called with four arguments.  The function should not only
 374 insert a note, but also ensure old notes are deleted.  See the documentation
 375 for `message-cross-post-insert-note'."
 376   :type 'function
 377   :group 'message-various)
 378
 379 ;;; End of variables adopted from `message-utils.el'.
 380
 381 ;;;###autoload
 382 (defcustom message-signature-separator "^-- *$"
 383   "Regexp matching the signature separator."
 384   :type 'regexp
 385   :group 'message-various)
 386
 387 (defcustom message-elide-ellipsis "\n[...]\n\n"
 388   "*The string which is inserted for elided text."
 389   :type 'string
 390   :group 'message-various)
 391
 392 (defcustom message-interactive t
 393   "Non-nil means when sending a message wait for and display errors.
 394 nil means let mailer mail back a message to report errors."
 395   :group 'message-sending
 396   :group 'message-mail
 397   :type 'boolean)
 398
 399 (defcustom message-generate-new-buffers 'unique
 400   "*Non-nil means create a new message buffer whenever `message-setup' is called.
 401 If this is a function, call that function with three parameters:  The type,
 402 the to address and the group name.  (Any of these may be nil.)  The function
 403 should return the new buffer name."
 404   :group 'message-buffers
 405   :type '(choice (const :tag "off" nil)
 406                  (const :tag "unique" unique)
 407                  (const :tag "unsent" unsent)
 408                  (function fun)))
 409
 410 (defcustom message-kill-buffer-on-exit nil
 411   "*Non-nil means that the message buffer will be killed after sending a message."
 412   :group 'message-buffers
 413   :type 'boolean)
 414
 415 (eval-when-compile
 416   (defvar gnus-local-organization))
 417 (defcustom message-user-organization
 418   (or (and (boundp 'gnus-local-organization)
 419            (stringp gnus-local-organization)
 420            gnus-local-organization)
 421       (getenv "ORGANIZATION")
 422       t)
 423   "*String to be used as an Organization header.
 424 If t, use `message-user-organization-file'."
 425   :group 'message-headers
 426   :type '(choice string
 427                  (const :tag "consult file" t)))
 428
 429 ;;;###autoload
 430 (defcustom message-user-organization-file "/usr/lib/news/organization"
 431   "*Local news organization file."
 432   :type 'file
 433   :group 'message-headers)
 434
 435 (defcustom message-make-forward-subject-function
 436   'message-forward-subject-name-subject
 437   "*List of functions called to generate subject headers for forwarded messages.
 438 The subject generated by the previous function is passed into each
 439 successive function.
 440
 441 The provided functions are:
 442
 443 * `message-forward-subject-author-subject' (Source of article (author or
 444       newsgroup)), in brackets followed by the subject
 445 * `message-forward-subject-name-subject' (Source of article (name of author
 446       or newsgroup)), in brackets followed by the subject
 447 * `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
 448       to it."
 449   :group 'message-forwarding
 450   :type '(radio (function-item message-forward-subject-author-subject)
 451                 (function-item message-forward-subject-fwd)
 452                 (repeat :tag "List of functions" function)))
 453
 454 (defcustom message-forward-as-mime t
 455   "*If non-nil, forward messages as an inline/rfc822 MIME section.  Otherwise, directly inline the old message in the forwarded message."
 456   :version "21.1"
 457   :group 'message-forwarding
 458   :type 'boolean)
 459
 460 (defcustom message-forward-show-mml t
 461   "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
 462   :version "21.1"
 463   :group 'message-forwarding
 464   :type 'boolean)
 465
 466 (defcustom message-forward-before-signature t
 467   "*If non-nil, put forwarded message before signature, else after."
 468   :group 'message-forwarding
 469   :type 'boolean)
 470
 471 (defcustom message-wash-forwarded-subjects nil
 472   "*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."
 473   :group 'message-forwarding
 474   :type 'boolean)
 475
 476 (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
 477   "*All headers that match this regexp will be deleted when resending a message."
 478   :group 'message-interface
 479   :type 'regexp)
 480
 481 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
 482   "*All headers that match this regexp will be deleted when forwarding a message."
 483   :version "21.1"
 484   :group 'message-forwarding
 485   :type '(choice (const :tag "None" nil)
 486                  regexp))
 487
 488 (defcustom message-ignored-cited-headers "."
 489   "*Delete these headers from the messages you yank."
 490   :group 'message-insertion
 491   :type 'regexp)
 492
 493 (defcustom message-cite-prefix-regexp
 494   (if (string-match "[[:digit:]]" "1") ;; support POSIX?
 495       "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
 496     ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
 497     (let ((old-table (syntax-table))
 498           non-word-constituents)
 499       (set-syntax-table text-mode-syntax-table)
 500       (setq non-word-constituents
 501             (concat
 502              (if (string-match "\\w" "-")  "" "-")
 503              (if (string-match "\\w" "_")  "" "_")
 504              (if (string-match "\\w" ".")  "" ".")))
 505       (set-syntax-table old-table)
 506       (if (equal non-word-constituents "")
 507           "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
 508         (concat "\\([ \t]*\\(\\w\\|["
 509                 non-word-constituents
 510                 "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
 511   "*Regexp matching the longest possible citation prefix on a line."
 512   :group 'message-insertion
 513   :type 'regexp)
 514
 515 (defcustom message-cancel-message "I am canceling my own article.\n"
 516   "Message to be inserted in the cancel message."
 517   :group 'message-interface
 518   :type 'string)
 519
 520 ;; Useful to set in site-init.el
 521 ;;;###autoload
 522 (defcustom message-send-mail-function 'message-send-mail-with-sendmail
 523   "Function to call to send the current buffer as mail.
 524 The headers should be delimited by a line whose contents match the
 525 variable `mail-header-separator'.
 526
 527 Valid values include `message-send-mail-with-sendmail' (the default),
 528 `message-send-mail-with-mh', `message-send-mail-with-qmail',
 529 `message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
 530
 531 See also `send-mail-function'."
 532   :type '(radio (function-item message-send-mail-with-sendmail)
 533                 (function-item message-send-mail-with-mh)
 534                 (function-item message-send-mail-with-qmail)
 535                 (function-item message-smtpmail-send-it)
 536                 (function-item smtpmail-send-it)
 537                 (function-item feedmail-send-it)
 538                 (function :tag "Other"))
 539   :group 'message-sending
 540   :group 'message-mail)
 541
 542 (defcustom message-send-news-function 'message-send-news
 543   "Function to call to send the current buffer as news.
 544 The headers should be delimited by a line whose contents match the
 545 variable `mail-header-separator'."
 546   :group 'message-sending
 547   :group 'message-news
 548   :type 'function)
 549
 550 (defcustom message-reply-to-function nil
 551   "If non-nil, function that should return a list of headers.
 552 This function should pick out addresses from the To, Cc, and From headers
 553 and respond with new To and Cc headers."
 554   :group 'message-interface
 555   :type '(choice function (const nil)))
 556
 557 (defcustom message-wide-reply-to-function nil
 558   "If non-nil, function that should return a list of headers.
 559 This function should pick out addresses from the To, Cc, and From headers
 560 and respond with new To and Cc headers."
 561   :group 'message-interface
 562   :type '(choice function (const nil)))
 563
 564 (defcustom message-followup-to-function nil
 565   "If non-nil, function