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 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: mail, news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This mode provides mail-sending facilities from within Emacs.  It
  29 ;; consists mainly of large chunks of code from the sendmail.el,
  30 ;; gnus-msg.el and rnewspost.el files.
  31
  32 ;;; Code:
  33
  34 (eval-when-compile
  35   (require 'cl)
  36   (defvar gnus-message-group-art)
  37   (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
  38   (require 'hashcash))
  39 (require 'canlock)
  40 (require 'mailheader)
  41 (require 'nnheader)
  42 ;; This is apparently necessary even though things are autoloaded.
  43 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
  44 ;; require mailabbrev here.
  45 (if (featurep 'xemacs)
  46     (require 'mail-abbrevs)
  47   (require 'mailabbrev))
  48 (require 'mail-parse)
  49 (require 'mml)
  50 (require 'rfc822)
  51
  52 (defgroup message '((user-mail-address custom-variable)
  53                     (user-full-name custom-variable))
  54   "Mail and news message composing."
  55   :link '(custom-manual "(message)Top")
  56   :group 'mail
  57   :group 'news)
  58
  59 (put 'user-mail-address 'custom-type 'string)
  60 (put 'user-full-name 'custom-type 'string)
  61
  62 (defgroup message-various nil
  63   "Various Message Variables."
  64   :link '(custom-manual "(message)Various Message Variables")
  65   :group 'message)
  66
  67 (defgroup message-buffers nil
  68   "Message Buffers."
  69   :link '(custom-manual "(message)Message Buffers")
  70   :group 'message)
  71
  72 (defgroup message-sending nil
  73   "Message Sending."
  74   :link '(custom-manual "(message)Sending Variables")
  75   :group 'message)
  76
  77 (defgroup message-interface nil
  78   "Message Interface."
  79   :link '(custom-manual "(message)Interface")
  80   :group 'message)
  81
  82 (defgroup message-forwarding nil
  83   "Message Forwarding."
  84   :link '(custom-manual "(message)Forwarding")
  85   :group 'message-interface)
  86
  87 (defgroup message-insertion nil
  88   "Message Insertion."
  89   :link '(custom-manual "(message)Insertion")
  90   :group 'message)
  91
  92 (defgroup message-headers nil
  93   "Message Headers."
  94   :link '(custom-manual "(message)Message Headers")
  95   :group 'message)
  96
  97 (defgroup message-news nil
  98   "Composing News Messages."
  99   :group 'message)
 100
 101 (defgroup message-mail nil
 102   "Composing Mail Messages."
 103   :group 'message)
 104
 105 (defgroup message-faces nil
 106   "Faces used for message composing."
 107   :group 'message
 108   :group 'faces)
 109
 110 (defcustom message-directory "~/Mail/"
 111   "*Directory from which all other mail file variables are derived."
 112   :group 'message-various
 113   :type 'directory)
 114
 115 (defcustom message-max-buffers 10
 116   "*How many buffers to keep before starting to kill them off."
 117   :group 'message-buffers
 118   :type 'integer)
 119
 120 (defcustom message-send-rename-function nil
 121   "Function called to rename the buffer after sending it."
 122   :group 'message-buffers
 123   :type '(choice function (const nil)))
 124
 125 (defcustom message-fcc-handler-function 'message-output
 126   "*A function called to save outgoing articles.
 127 This function will be called with the name of the file to store the
 128 article in.  The default function is `message-output' which saves in Unix
 129 mailbox format."
 130   :type '(radio (function-item message-output)
 131                 (function :tag "Other"))
 132   :group 'message-sending)
 133
 134 (defcustom message-fcc-externalize-attachments nil
 135   "If non-nil, attachments are included as external parts in Fcc copies."
 136   :version "22.1"
 137   :type 'boolean
 138   :group 'message-sending)
 139
 140 (defcustom message-courtesy-message
 141   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 142   "*This is inserted at the start of a mailed copy of a posted message.
 143 If the string contains the format spec \"%s\", the Newsgroups
 144 the article has been posted to will be inserted there.
 145 If this variable is nil, no such courtesy message will be added."
 146   :group 'message-sending
 147   :type '(radio string (const nil)))
 148
 149 (defcustom message-ignored-bounced-headers
 150   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
 151   "*Regexp that matches headers to be removed in resent bounced mail."
 152   :group 'message-interface
 153   :type 'regexp)
 154
 155 ;;;###autoload
 156 (defcustom message-from-style 'default
 157   "*Specifies how \"From\" headers look.
 158
 159 If nil, they contain just the return address like:
 160         king@grassland.com
 161 If `parens', they look like:
 162         king@grassland.com (Elvis Parsley)
 163 If `angles', they look like:
 164         Elvis Parsley <king@grassland.com>
 165
 166 Otherwise, most addresses look like `angles', but they look like
 167 `parens' if `angles' would need quoting and `parens' would not."
 168   :type '(choice (const :tag "simple" nil)
 169                  (const parens)
 170                  (const angles)
 171                  (const default))
 172   :group 'message-headers)
 173
 174 (defcustom message-insert-canlock t
 175   "Whether to insert a Cancel-Lock header in news postings."
 176   :version "22.1"
 177   :group 'message-headers
 178   :type 'boolean)
 179
 180 (defcustom message-syntax-checks
 181   (if message-insert-canlock '((sender . disabled)) nil)
 182   ;; Guess this one shouldn't be easy to customize...
 183   "*Controls what syntax checks should not be performed on outgoing posts.
 184 To disable checking of long signatures, for instance, add
 185  `(signature . disabled)' to this list.
 186
 187 Don't touch this variable unless you really know what you're doing.
 188
 189 Checks include `subject-cmsg', `multiple-headers', `sendsys',
 190 `message-id', `from', `long-lines', `control-chars', `size',
 191 `new-text', `quoting-style', `redirected-followup', `signature',
 192 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 193 `subject', `shorten-followup-to', `existing-newsgroups',
 194 `buffer-file-name', `unchanged', `newsgroups', `reply-to',
 195 `continuation-headers', `long-header-lines', `invisible-text' and
 196 `illegible-text'."
 197   :group 'message-news
 198   :type '(repeat sexp))                 ; Fixme: improve this
 199
 200 (defcustom message-required-headers '((optional . References)
 201                                       From)
 202   "*Headers to be generated or prompted for when sending a message.
 203 Also see `message-required-news-headers' and
 204 `message-required-mail-headers'."
 205   :version "22.1"
 206   :group 'message-news
 207   :group 'message-headers
 208   :link '(custom-manual "(message)Message Headers")
 209   :type '(repeat sexp))
 210
 211 (defcustom message-draft-headers '(References From)
 212   "*Headers to be generated when saving a draft message."
 213   :version "22.1"
 214   :group 'message-news
 215   :group 'message-headers
 216   :link '(custom-manual "(message)Message Headers")
 217   :type '(repeat sexp))
 218
 219 (defcustom message-required-news-headers
 220   '(From Newsgroups Subject Date Message-ID
 221          (optional . Organization)
 222          (optional . User-Agent))
 223   "*Headers to be generated or prompted for when posting an article.
 224 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 225 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 226 User-Agent are optional.  If don't you want message to insert some
 227 header, remove it from this list."
 228   :group 'message-news
 229   :group 'message-headers
 230   :link '(custom-manual "(message)Message Headers")
 231   :type '(repeat sexp))
 232
 233 (defcustom message-required-mail-headers
 234   '(From Subject Date (optional . In-Reply-To) Message-ID
 235          (optional . User-Agent))
 236   "*Headers to be generated or prompted for when mailing a message.
 237 It is recommended that From, Date, To, Subject and Message-ID be
 238 included.  Organization and User-Agent are optional."
 239   :group 'message-mail
 240   :group 'message-headers
 241   :link '(custom-manual "(message)Message Headers")
 242   :type '(repeat sexp))
 243
 244 (defcustom message-deletable-headers '(Message-ID Date Lines)
 245   "Headers to be deleted if they already exist and were generated by message previously."
 246   :group 'message-headers
 247   :link '(custom-manual "(message)Message Headers")
 248   :type 'sexp)
 249
 250 (defcustom message-ignored-news-headers
 251   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 252   "*Regexp of headers to be removed unconditionally before posting."
 253   :group 'message-news
 254   :group 'message-headers
 255   :link '(custom-manual "(message)Message Headers")
 256   :type '(repeat :value-to-internal (lambda (widget value)
 257                                       (custom-split-regexp-maybe value))
 258                  :match (lambda (widget value)
 259                           (or (stringp value)
 260                               (widget-editable-list-match widget value)))
 261                  regexp))
 262
 263 (defcustom message-ignored-mail-headers
 264   "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 265   "*Regexp of headers to be removed unconditionally before mailing."
 266   :group 'message-mail
 267   :group 'message-headers
 268   :link '(custom-manual "(message)Mail Headers")
 269   :type 'regexp)
 270
 271 (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
 272   "*Header lines matching this regexp will be deleted before posting.
 273 It's best to delete old Path and Date headers before posting to avoid
 274 any confusion."
 275   :group 'message-interface
 276   :link '(custom-manual "(message)Superseding")
 277   :type '(repeat :value-to-internal (lambda (widget value)
 278                                       (custom-split-regexp-maybe value))
 279                  :match (lambda (widget value)
 280                           (or (stringp value)
 281                               (widget-editable-list-match widget value)))
 282                  regexp))
 283
 284 (defcustom message-subject-re-regexp
 285   "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
 286   "*Regexp matching \"Re: \" in the subject line."
 287   :group 'message-various
 288   :link '(custom-manual "(message)Message Headers")
 289   :type 'regexp)
 290
 291 ;;; Start of variables adopted from `message-utils.el'.
 292
 293 (defcustom message-subject-trailing-was-query 'ask
 294   "*What to do with trailing \"(was: <old subject>)\" in subject lines.
 295 If nil, leave the subject unchanged.  If it is the symbol `ask', query
 296 the user what do do.  In this case, the subject is matched against
 297 `message-subject-trailing-was-ask-regexp'.  If
 298 `message-subject-trailing-was-query' is t, always strip the trailing
 299 old subject.  In this case, `message-subject-trailing-was-regexp' is
 300 used."
 301   :version "22.1"
 302   :type '(choice (const :tag "never" nil)
 303                  (const :tag "always strip" t)
 304                  (const ask))
 305   :link '(custom-manual "(message)Message Headers")
 306   :group 'message-various)
 307
 308 (defcustom message-subject-trailing-was-ask-regexp
 309   "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
 310   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 311
 312 The function `message-strip-subject-trailing-was' uses this regexp if
 313 `message-subject-trailing-was-query' is set to the symbol `ask'.  If
 314 the variable is t instead of `ask', use
 315 `message-subject-trailing-was-regexp' instead.
 316
 317 It is okay to create some false positives here, as the user is asked."
 318   :version "22.1"
 319   :group 'message-various
 320   :link '(custom-manual "(message)Message Headers")
 321   :type 'regexp)
 322
 323 (defcustom message-subject-trailing-was-regexp
 324   "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
 325   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 326
 327 If `message-subject-trailing-was-query' is set to t, the subject is
 328 matched against `message-subject-trailing-was-regexp' in
 329 `message-strip-subject-trailing-was'.  You should use a regexp creating very
 330 few false positives here."
 331   :version "22.1"
 332   :group 'message-various
 333   :link '(custom-manual "(message)Message Headers")
 334   :type 'regexp)
 335
 336 ;;; marking inserted text
 337
 338 (defcustom message-mark-insert-begin
 339   "--8<---------------cut here---------------start------------->8---\n"
 340   "How to mark the beginning of some inserted text."