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

   1 ;;; message.el --- composing mail and news messages
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: mail, news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  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-and-compile
  33   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  34 (eval-when-compile
  35   (require 'cl))
  36
  37 (require 'mailheader)
  38 (require 'gmm-utils)
  39 (require 'mail-utils)
  40 ;; Only for the trivial macros mail-header-from, mail-header-date
  41 ;; mail-header-references, mail-header-subject, mail-header-id
  42 (eval-when-compile (require 'nnheader))
  43 ;; This is apparently necessary even though things are autoloaded.
  44 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
  45 ;; require mailabbrev here.
  46 (if (featurep 'xemacs)
  47     (require 'mail-abbrevs)
  48   (require 'mailabbrev))
  49 (require 'mail-parse)
  50 (require 'mml)
  51 (require 'rfc822)
  52
  53 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
  54
  55 (defvar gnus-message-group-art)
  56 (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
  57 (defvar rmail-enable-mime-composing)
  58
  59 (defgroup message '((user-mail-address custom-variable)
  60                     (user-full-name custom-variable))
  61   "Mail and news message composing."
  62   :link '(custom-manual "(message)Top")
  63   :group 'mail
  64   :group 'news)
  65
  66 (put 'user-mail-address 'custom-type 'string)
  67 (put 'user-full-name 'custom-type 'string)
  68
  69 (defgroup message-various nil
  70   "Various Message Variables."
  71   :link '(custom-manual "(message)Various Message Variables")
  72   :group 'message)
  73
  74 (defgroup message-buffers nil
  75   "Message Buffers."
  76   :link '(custom-manual "(message)Message Buffers")
  77   :group 'message)
  78
  79 (defgroup message-sending nil
  80   "Message Sending."
  81   :link '(custom-manual "(message)Sending Variables")
  82   :group 'message)
  83
  84 (defgroup message-interface nil
  85   "Message Interface."
  86   :link '(custom-manual "(message)Interface")
  87   :group 'message)
  88
  89 (defgroup message-forwarding nil
  90   "Message Forwarding."
  91   :link '(custom-manual "(message)Forwarding")
  92   :group 'message-interface)
  93
  94 (defgroup message-insertion nil
  95   "Message Insertion."
  96   :link '(custom-manual "(message)Insertion")
  97   :group 'message)
  98
  99 (defgroup message-headers nil
 100   "Message Headers."
 101   :link '(custom-manual "(message)Message Headers")
 102   :group 'message)
 103
 104 (defgroup message-news nil
 105   "Composing News Messages."
 106   :group 'message)
 107
 108 (defgroup message-mail nil
 109   "Composing Mail Messages."
 110   :group 'message)
 111
 112 (defgroup message-faces nil
 113   "Faces used for message composing."
 114   :group 'message
 115   :group 'faces)
 116
 117 (defcustom message-directory "~/Mail/"
 118   "*Directory from which all other mail file variables are derived."
 119   :group 'message-various
 120   :type 'directory)
 121
 122 (defcustom message-max-buffers 10
 123   "*How many buffers to keep before starting to kill them off."
 124   :group 'message-buffers
 125   :type 'integer)
 126
 127 (defcustom message-send-rename-function nil
 128   "Function called to rename the buffer after sending it."
 129   :group 'message-buffers
 130   :type '(choice function (const nil)))
 131
 132 (defcustom message-fcc-handler-function 'message-output
 133   "*A function called to save outgoing articles.
 134 This function will be called with the name of the file to store the
 135 article in.  The default function is `message-output' which saves in Unix
 136 mailbox format."
 137   :type '(radio (function-item message-output)
 138                 (function :tag "Other"))
 139   :group 'message-sending)
 140
 141 (defcustom message-fcc-externalize-attachments nil
 142   "If non-nil, attachments are included as external parts in Fcc copies."
 143   :version "22.1"
 144   :type 'boolean
 145   :group 'message-sending)
 146
 147 (defcustom message-courtesy-message
 148   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 149   "*This is inserted at the start of a mailed copy of a posted message.
 150 If the string contains the format spec \"%s\", the Newsgroups
 151 the article has been posted to will be inserted there.
 152 If this variable is nil, no such courtesy message will be added."
 153   :group 'message-sending
 154   :type '(radio string (const nil)))
 155
 156 (defcustom message-ignored-bounced-headers
 157   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
 158   "*Regexp that matches headers to be removed in resent bounced mail."
 159   :group 'message-interface
 160   :type 'regexp)
 161
 162 (defcustom message-from-style 'default
 163   ;; In Emacs 24.1 this defaults to the value of `mail-from-style'
 164   ;; that defaults to:
 165   ;; `angles' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
 166   ;; `default' in Emacs 23.2, and 24.1
 167   "*Specifies how \"From\" headers look.
 168
 169 If nil, they contain just the return address like:
 170         king@grassland.com
 171 If `parens', they look like:
 172         king@grassland.com (Elvis Parsley)
 173 If `angles', they look like:
 174         Elvis Parsley <king@grassland.com>
 175
 176 Otherwise, most addresses look like `angles', but they look like
 177 `parens' if `angles' would need quoting and `parens' would not."
 178   :version "23.2"
 179   :type '(choice (const :tag "simple" nil)
 180                  (const parens)
 181                  (const angles)
 182                  (const default))
 183   :group 'message-headers)
 184
 185 (defcustom message-insert-canlock t
 186   "Whether to insert a Cancel-Lock header in news postings."
 187   :version "22.1"
 188   :group 'message-headers
 189   :type 'boolean)
 190
 191 (defcustom message-syntax-checks
 192   (if message-insert-canlock '((sender . disabled)) nil)
 193   ;; Guess this one shouldn't be easy to customize...
 194   "*Controls what syntax checks should not be performed on outgoing posts.
 195 To disable checking of long signatures, for instance, add
 196  `(signature . disabled)' to this list.
 197
 198 Don't touch this variable unless you really know what you're doing.
 199
 200 Checks include `approved', `bogus-recipient', `continuation-headers',
 201 `control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
 202 `invisible-text', `long-header-lines', `long-lines', `message-id',
 203 `multiple-headers', `new-text', `newsgroups', `quoting-style',
 204 `repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
 205 `shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
 206 and `valid-newsgroups'."
 207   :group 'message-news
 208   :type '(repeat sexp))                 ; Fixme: improve this
 209
 210 (defcustom message-required-headers '((optional . References)
 211                                       From)
 212   "*Headers to be generated or prompted for when sending a message.
 213 Also see `message-required-news-headers' and
 214 `message-required-mail-headers'."
 215   :version "22.1"
 216   :group 'message-news
 217   :group 'message-headers
 218   :link '(custom-manual "(message)Message Headers")
 219   :type '(repeat sexp))
 220
 221 (defcustom message-draft-headers '(References From Date)
 222   "*Headers to be generated when saving a draft message."
 223   :version "22.1"
 224   :group 'message-news
 225   :group 'message-headers
 226   :link '(custom-manual "(message)Message Headers")
 227   :type '(repeat sexp))
 228
 229 (defcustom message-required-news-headers
 230   '(From Newsgroups Subject Date Message-ID
 231          (optional . Organization)
 232          (optional . User-Agent))
 233   "*Headers to be generated or prompted for when posting an article.
 234 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 235 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 236 User-Agent are optional.  If you don't want message to insert some
 237 header, remove it from this list."
 238   :group 'message-news
 239   :group 'message-headers
 240   :link '(custom-manual "(message)Message Headers")
 241   :type '(repeat sexp))
 242
 243 (defcustom message-required-mail-headers
 244   '(From Subject Date (optional . In-Reply-To) Message-ID
 245          (optional . User-Agent))
 246   "*Headers to be generated or prompted for when mailing a message.
 247 It is recommended that From, Date, To, Subject and Message-ID be
 248 included.  Organization and User-Agent are optional."
 249   :group 'message-mail
 250   :group 'message-headers
 251   :link '(custom-manual "(message)Message Headers")
 252   :type '(repeat sexp))
 253
 254 (defcustom message-prune-recipient-rules nil
 255   "Rules for how to prune the list of recipients when doing wide replies.
 256 This is a list of regexps and regexp matches."
 257   :version "24.1"
 258   :group 'message-mail
 259   :group 'message-headers
 260   :link '(custom-manual "(message)Wide Reply")
 261   :type '(repeat regexp))
 262
 263 (defcustom message-deletable-headers '(Message-ID Date Lines)
 264   "Headers to be deleted if they already exist and were generated by message previously."
 265   :group 'message-headers
 266   :link '(custom-manual "(message)Message Headers")
 267   :type 'sexp)
 268
 269 (defcustom message-ignored-news-headers
 270   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 271   "*Regexp of headers to be removed unconditionally before posting."
 272   :group 'message-news
 273   :group 'message-headers
 274   :link '(custom-manual "(message)Message Headers")
 275   :type '(repeat :value-to-internal (lambda (widget value)
 276                                       (custom-split-regexp-maybe value))
 277                  :match (lambda (widget value)
 278                           (or (stringp value)
 279                               (widget-editable-list-match widget value)))
 280                  regexp))
 281
 282 (defcustom message-ignored-mail-headers
 283   "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 284   "*Regexp of headers to be removed unconditionally before mailing."
 285   :group 'message-mail
 286   :group 'message-headers
 287   :link '(custom-manual "(message)Mail Headers")
 288   :type 'regexp)
 289
 290 (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:"
 291   "*Header lines matching this regexp will be deleted before posting.
 292 It's best to delete old Path and Date headers before posting to avoid
 293 any confusion."
 294   :group 'message-interface
 295   :link '(custom-manual "(message)Superseding")
 296   :type '(repeat :value-to-internal (lambda (widget value)
 297                                       (custom-split-regexp-maybe value))
 298                  :match (lambda (widget value)
 299                           (or (stringp value)
 300                               (widget-editable-list-match widget value)))
 301                  regexp))
 302
 303 (defcustom message-subject-re-regexp
 304   "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
 305   "*Regexp matching \"Re: \" in the subject line."
 306   :group 'message-various
 307   :link '(custom-manual "(message)Message Headers")
 308   :type 'regexp)
 309
 310 ;;; Start of variables adopted from `message-utils.el'.
 311
 312 (defcustom message-subject-trailing-was-query 'ask
 313   "*What to do with trailing \"(was: <old subject>)\" in subject lines.
 314 If nil, leave the subject unchanged.  If it is the symbol `ask', query
 315 the user what do do.  In this case, the subject is matched against
 316 `message-subject-trailing-was-ask-regexp'.  If
 317 `message-subject-trailing-was-query' is t, always strip the trailing
 318 old subject.  In this case, `message-subject-trailing-was-regexp' is
 319 used."
 320   :version "22.1"
 321   :type '(choice (const :tag "never" nil)
 322                  (const :tag "always strip" t)
 323                  (const ask))
 324   :link '(custom-manual "(message)Message Headers")
 325   :group 'message-various)
 326
 327 (defcustom message-subject-trailing-was-ask-regexp
 328   "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
 329   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 330
 331 The function `message-strip-subject-trailing-was' uses this regexp if
 332 `message-subject-trailing-was-query' is set to the symbol `ask'.  If
 333 the variable is t instead of `ask', use
 334 `message-subject-trailing-was-regexp' instead.
 335
 336 It is okay to create some false positives here, as the user is asked."
 337   :version "22.1"
 338   :group 'message-various
 339   :link '(custom-manual "(message)Message Headers")
 340   :type 'regexp)
 341
 342 (defcustom message-subject-trailing-was-regexp
 343   "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
 344   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 345
 346 If `message-subject-trailing-was-query' is set to t, the subject is
 347 matched against `message-subject-trailing-was-regexp' in
 348 `message-strip-subject-trailing-was'.  You should use a regexp creating very
 349 few false positives here."
 350   :version "22.1"
 351   :group 'message-various
 352   :link '(custom-manual "(message)Message Headers")
 353   :type 'regexp)
 354
 355 ;;; marking inserted text
 356
 357 (defcustom message-mark-insert-begin
 358   "--8<---------------cut here---------------start------------->8---\n"
 359   "How to mark the beginning of some inserted text."
 360   :version "22.1"
 361   :type 'string
 362   :link '(custom-manual "(message)Insertion Variables")
 363   :group 'message-various)
 364
 365 (defcustom message-mark-insert-end
 366   "--8<---------------cut here---------------end--------------->8---\n"
 367   "How to mark the end of some inserted text."
 368   :version "22.1"
 369   :type 'string
 370   :link '(custom-manual "(message)Insertion Variables")
 371   :group 'message-various)
 372
 373 (defcustom message-archive-header "X-No-Archive: Yes\n"
 374   "Header to insert when you don't want your article to be archived.
 375 Archives \(such as groups.google.com\) respect this header."
 376   :version "22.1"
 377   :type 'string
 378   :link '(custom-manual "(message)Header Commands")
 379   :group 'message-various)
 380
 381 (defcustom message-archive-note
 382   "X-No-Archive: Yes - save http://groups.google.com/"
 383   "Note to insert why you wouldn't want this posting archived.
 384 If nil, don't insert any text in the body."
 385   :version "22.1"
 386   :type '(radio string (const nil))
 387   :link '(custom-manual "(message)Header Commands")
 388   :group 'message-various)
 389
 390 ;;; Crossposts and Followups
 391 ;; inspired by JoH-followup-to by Jochem Huhman <joh  at gmx.de>
 392 ;; new suggestions by R. Weikusat <rw at another.de>
 393
 394 (defvar message-cross-post-old-target nil
 395   "Old target for cross-posts or follow-ups.")
 396 (make-variable-buffer-local 'message-cross-post-old-target)
 397
 398 (defcustom message-cross-post-default t
 399   "When non-nil `message-cross-post-followup-to' will perform a crosspost.
 400 If nil, `message-cross-post-followup-to' will only do a followup.  Note that
 401 you can explicitly override this setting by calling
 402 `message-cross-post-followup-to' with a prefix."
 403   :version "22.1"
 404   :type 'boolean
 405   :group 'message-various)
 406
 407 (defcustom message-cross-post-note "Crosspost & Followup-To: "
 408   "Note to insert before signature to notify of cross-post and follow-up."
 409   :version "22.1"
 410   :type 'string
 411   :group 'message-various)
 412
 413 (defcustom message-followup-to-note "Followup-To: "
 414   "Note to insert before signature to notify of follow-up only."
 415   :version "22.1"
 416   :type 'string
 417   :group 'message-various)
 418
 419 (defcustom message-cross-post-note-function 'message-cross-post-insert-note
 420   "Function to use to insert note about Crosspost or Followup-To.
 421 The function will be called with four arguments.  The function should not only
 422 insert a note, but also ensure old notes are deleted.  See the documentation
 423 for `message-cross-post-insert-note'."
 424   :version "22.1"
 425   :type 'function
 426   :group 'message-various)
 427
 428 ;;; End of variables adopted from `message-utils.el'.
 429
 430 (defcustom message-signature-separator "^-- $"
 431   "Regexp matching the signature separator.
 432 This variable is used to strip off the signature from quoted text
 433 when `message-cite-function' is
 434 `message-cite-original-without-signature'.  Most useful values
 435 are \"^-- $\" (strict) and \"^-- *$\" (loose; allow missing
 436 whitespace)."
 437   :type '(choice (const :tag "strict" "^-- $")
 438                  (const :tag "loose" "^-- *$")
 439                  regexp)
 440   :version "22.3" ;; Gnus 5.10.12 (changed default)
 441   :link '(custom-manual "(message)Various Message Variables")
 442   :group 'message-various)
 443
 444 (defcustom message-elide-ellipsis "\n[...]\n\n"
 445   "*The string which is inserted for elided text."
 446   :type 'string
 447   :link '(custom-manual "(message)Various Commands")
 448   :group 'message-various)
 449
 450 (defcustom message-interactive t
 451   ;; In Emacs 24.1 this defaults to the value of `mail-interactive'
 452   ;; that defaults to:
 453   ;; `nil' in Emacs 22.1~22.3, XEmacs 21.4, 21.5, and SXEmacs 22.1;
 454   ;; `t' in Emacs 23.1~24.1
 455   "Non-nil means when sending a message wait for and display errors.
 456 A value of nil means let mailer mail back a message to report errors."
 457   :version "23.2"
 458   :group 'message-sending
 459   :group 'message-mail
 460   :link '(custom-manual "(message)Sending Variables")
 461   :type 'boolean)
 462
 463 (defcustom message-confirm-send nil
 464   "When non-nil, ask for confirmation when sending a message."
 465   :group 'message-sending
 466   :group 'message-mail<