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, 2004, 2005
   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-message-group-art)
  36   (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
  37   (require 'hashcash))
  38 (require 'canlock)
  39 (require 'mailheader)
  40 (require 'nnheader)
  41 ;; This is apparently necessary even though things are autoloaded.
  42 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
  43 ;; require mailabbrev here.
  44 (if (featurep 'xemacs)
  45     (require 'mail-abbrevs)
  46   (require 'mailabbrev))
  47 (require 'mail-parse)
  48 (require 'mml)
  49 (require 'rfc822)
  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   :version "22.1"
 136   :type 'boolean
 137   :group 'message-sending)
 138
 139 (defcustom message-courtesy-message
 140   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
 141   "*This is inserted at the start of a mailed copy of a posted message.
 142 If the string contains the format spec \"%s\", the Newsgroups
 143 the article has been posted to will be inserted there.
 144 If this variable is nil, no such courtesy message will be added."
 145   :group 'message-sending
 146   :type '(radio string (const nil)))
 147
 148 (defcustom message-ignored-bounced-headers
 149   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
 150   "*Regexp that matches headers to be removed in resent bounced mail."
 151   :group 'message-interface
 152   :type 'regexp)
 153
 154 ;;;###autoload
 155 (defcustom message-from-style 'default
 156   "*Specifies how \"From\" headers look.
 157
 158 If nil, they contain just the return address like:
 159         king@grassland.com
 160 If `parens', they look like:
 161         king@grassland.com (Elvis Parsley)
 162 If `angles', they look like:
 163         Elvis Parsley <king@grassland.com>
 164
 165 Otherwise, most addresses look like `angles', but they look like
 166 `parens' if `angles' would need quoting and `parens' would not."
 167   :type '(choice (const :tag "simple" nil)
 168                  (const parens)
 169                  (const angles)
 170                  (const default))
 171   :group 'message-headers)
 172
 173 (defcustom message-insert-canlock t
 174   "Whether to insert a Cancel-Lock header in news postings."
 175   :version "22.1"
 176   :group 'message-headers
 177   :type 'boolean)
 178
 179 (defcustom message-syntax-checks
 180   (if message-insert-canlock '((sender . disabled)) nil)
 181   ;; Guess this one shouldn't be easy to customize...
 182   "*Controls what syntax checks should not be performed on outgoing posts.
 183 To disable checking of long signatures, for instance, add
 184  `(signature . disabled)' to this list.
 185
 186 Don't touch this variable unless you really know what you're doing.
 187
 188 Checks include `subject-cmsg', `multiple-headers', `sendsys',
 189 `message-id', `from', `long-lines', `control-chars', `size',
 190 `new-text', `quoting-style', `redirected-followup', `signature',
 191 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 192 `subject', `shorten-followup-to', `existing-newsgroups',
 193 `buffer-file-name', `unchanged', `newsgroups', `reply-to',
 194 `continuation-headers', `long-header-lines', `invisible-text' and
 195 `illegible-text'."
 196   :group 'message-news
 197   :type '(repeat sexp))                 ; Fixme: improve this
 198
 199 (defcustom message-required-headers '((optional . References)
 200                                       From)
 201   "*Headers to be generated or prompted for when sending a message.
 202 Also see `message-required-news-headers' and
 203 `message-required-mail-headers'."
 204   :version "22.1"
 205   :group 'message-news
 206   :group 'message-headers
 207   :link '(custom-manual "(message)Message Headers")
 208   :type '(repeat sexp))
 209
 210 (defcustom message-draft-headers '(References From)
 211   "*Headers to be generated when saving a draft message."
 212   :version "22.1"
 213   :group 'message-news
 214   :group 'message-headers
 215   :link '(custom-manual "(message)Message Headers")
 216   :type '(repeat sexp))
 217
 218 (defcustom message-required-news-headers
 219   '(From Newsgroups Subject Date Message-ID
 220          (optional . Organization)
 221          (optional . User-Agent))
 222   "*Headers to be generated or prompted for when posting an article.
 223 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 224 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 225 User-Agent are optional.  If don't you want message to insert some
 226 header, remove it from this list."
 227   :group 'message-news
 228   :group 'message-headers
 229   :link '(custom-manual "(message)Message Headers")
 230   :type '(repeat sexp))
 231
 232 (defcustom message-required-mail-headers
 233   '(From Subject Date (optional . In-Reply-To) Message-ID
 234          (optional . User-Agent))
 235   "*Headers to be generated or prompted for when mailing a message.
 236 It is recommended that From, Date, To, Subject and Message-ID be
 237 included.  Organization and User-Agent are optional."
 238   :group 'message-mail
 239   :group 'message-headers
 240   :link '(custom-manual "(message)Message Headers")
 241   :type '(repeat sexp))
 242
 243 (defcustom message-deletable-headers '(Message-ID Date Lines)
 244   "Headers to be deleted if they already exist and were generated by message previously."
 245   :group 'message-headers
 246   :link '(custom-manual "(message)Message Headers")
 247   :type 'sexp)
 248
 249 (defcustom message-ignored-news-headers
 250   "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
 251   "*Regexp of headers to be removed unconditionally before posting."
 252   :group 'message-news
 253   :group 'message-headers
 254   :link '(custom-manual "(message)Message Headers")
 255   :type '(repeat :value-to-internal (lambda (widget value)
 256                                       (custom-split-regexp-maybe value))
 257                  :match (lambda (widget value)
 258                           (or (stringp value)
 259                               (widget-editable-list-match widget value)))
 260                  regexp))
 261