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