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

   1 ;;; gnus-art.el --- article mode commands for Gnus
   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: 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 ;;; Code:
  28
  29 (eval-when-compile
  30   (require 'cl)
  31   (defvar tool-bar-map))
  32
  33 (require 'gnus)
  34 (require 'gnus-sum)
  35 (require 'gnus-spec)
  36 (require 'gnus-int)
  37 (require 'gnus-win)
  38 (require 'mm-bodies)
  39 (require 'mail-parse)
  40 (require 'mm-decode)
  41 (require 'mm-view)
  42 (require 'wid-edit)
  43 (require 'mm-uu)
  44 (require 'message)
  45
  46 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  47 (autoload 'gnus-button-mailto "gnus-msg")
  48 (autoload 'gnus-button-reply "gnus-msg" nil t)
  49
  50 (defgroup gnus-article nil
  51   "Article display."
  52   :link '(custom-manual "(gnus)The Article Buffer")
  53   :group 'gnus)
  54
  55 (defgroup gnus-article-treat nil
  56   "Treating article parts."
  57   :link '(custom-manual "(gnus)Article Hiding")
  58   :group 'gnus-article)
  59
  60 (defgroup gnus-article-hiding nil
  61   "Hiding article parts."
  62   :link '(custom-manual "(gnus)Article Hiding")
  63   :group 'gnus-article)
  64
  65 (defgroup gnus-article-highlight nil
  66   "Article highlighting."
  67   :link '(custom-manual "(gnus)Article Highlighting")
  68   :group 'gnus-article
  69   :group 'gnus-visual)
  70
  71 (defgroup gnus-article-signature nil
  72   "Article signatures."
  73   :link '(custom-manual "(gnus)Article Signature")
  74   :group 'gnus-article)
  75
  76 (defgroup gnus-article-headers nil
  77   "Article headers."
  78   :link '(custom-manual "(gnus)Hiding Headers")
  79   :group 'gnus-article)
  80
  81 (defgroup gnus-article-washing nil
  82   "Special commands on articles."
  83   :link '(custom-manual "(gnus)Article Washing")
  84   :group 'gnus-article)
  85
  86 (defgroup gnus-article-emphasis nil
  87   "Fontisizing articles."
  88   :link '(custom-manual "(gnus)Article Fontisizing")
  89   :group 'gnus-article)
  90
  91 (defgroup gnus-article-saving nil
  92   "Saving articles."
  93   :link '(custom-manual "(gnus)Saving Articles")
  94   :group 'gnus-article)
  95
  96 (defgroup gnus-article-mime nil
  97   "Worshiping the MIME wonder."
  98   :link '(custom-manual "(gnus)Using MIME")
  99   :group 'gnus-article)
 100
 101 (defgroup gnus-article-buttons nil
 102   "Pushable buttons in the article buffer."
 103   :link '(custom-manual "(gnus)Article Buttons")
 104   :group 'gnus-article)
 105
 106 (defgroup gnus-article-various nil
 107   "Other article options."
 108   :link '(custom-manual "(gnus)Misc Article")
 109   :group 'gnus-article)
 110
 111 (defcustom gnus-ignored-headers
 112   (mapcar
 113    (lambda (header)
 114      (concat "^" header ":"))
 115    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 116      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 117      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 118      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 119      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 120      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 121      "X-Attribution" "X-Originating-IP" "Delivered-To"
 122      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 123      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 124      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 125      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 126      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 127      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 128      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 129      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 130      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 131      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 132      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 133      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 134      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 135      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 136      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 137      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 138      "List-[A-Za-z]+" "X-Listprocessor-Version"
 139      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 140      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 141      "X-Received" "Content-length" "X-precedence"
 142      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 143      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 144      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 145      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 146      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 147      "X-Content-length" "X-Posting-Agent" "Original-Received"
 148      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 149      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 150      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 151      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 152      "X-Abuse-and-DMCA-Info" "X-Postfilter"))
 153   "*All headers that start with this regexp will be hidden.
 154 This variable can also be a list of regexps of headers to be ignored.
 155 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 156   :type '(choice :custom-show nil
 157                  regexp
 158                  (repeat regexp))
 159   :group 'gnus-article-hiding)
 160
 161 (defcustom gnus-visible-headers
 162   "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
 163   "*All headers that do not match this regexp will be hidden.
 164 This variable can also be a list of regexp of headers to remain visible.
 165 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 166   :type '(repeat :value-to-internal (lambda (widget value)
 167                                       (custom-split-regexp-maybe value))
 168                  :match (lambda (widget value)
 169                           (or (stringp value)
 170                               (widget-editable-list-match widget value)))
 171                  regexp)
 172   :group 'gnus-article-hiding)
 173
 174 (defcustom gnus-sorted-header-list
 175   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 176     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 177   "*This variable is a list of regular expressions.
 178 If it is non-nil, headers that match the regular expressions will
 179 be placed first in the article buffer in the sequence specified by
 180 this list."
 181   :type '(repeat regexp)
 182   :group 'gnus-article-hiding)
 183
 184 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 185   "Headers that are only to be displayed if they have interesting data.
 186 Possible values in this list are:
 187
 188   'empty       Headers with no content.
 189   'newsgroups  Newsgroup identical to Gnus group.
 190   'to-address  To identical to To-address.
 191   'to-list     To identical to To-list.
 192   'cc-list     CC identical to To-list.
 193   'followup-to Followup-to identical to Newsgroups.
 194   'reply-to    Reply-to identical to From.
 195   'date        Date less than four days old.
 196   'long-to     To and/or Cc longer than 1024 characters.
 197   'many-to     Multiple To and/or Cc."
 198   :type '(set (const :tag "Headers with no content." empty)
 199               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 200               (const :tag "To identical to To-address." to-address)
 201               (const :tag "To identical to To-list." to-list)
 202               (const :tag "CC identical to To-list." cc-list)
 203               (const :tag "Followup-to identical to Newsgroups." followup-to)
 204               (const :tag "Reply-to identical to From." reply-to)
 205               (const :tag "Date less than four days old." date)
 206               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 207               (const :tag "Multiple To and/or Cc headers." many-to))
 208   :group 'gnus-article-hiding)
 209
 210 (defcustom gnus-article-skip-boring nil
 211   "Skip over text that is not worth reading.
 212 By default, if you set this t, then Gnus will display citations and
 213 signatures, but will never scroll down to show you a page consisting
 214 only of boring text.  Boring text is controlled by
 215 `gnus-article-boring-faces'."
 216   :type 'boolean
 217   :group 'gnus-article-hiding)
 218
 219 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 220   "Regexp matching signature separator.
 221 This can also be a list of regexps.  In that case, it will be checked
 222 from head to tail looking for a separator.  Searches will be done from
 223 the end of the buffer."
 224   :type '(repeat string)
 225   :group 'gnus-article-signature)
 226
 227 (defcustom gnus-signature-limit nil
 228   "Provide a limit to what is considered a signature.
 229 If it is a number, no signature may not be longer (in characters) than
 230 that number.  If it is a floating point number, no signature may be
 231 longer (in lines) than that number.  If it is a function, the function
 232 will be called without any parameters, and if it returns nil, there is
 233 no signature in the buffer.  If it is a string, it will be used as a
 234 regexp.  If it matches, the text in question is not a signature."
 235   :type '(choice (integer :value 200)
 236                  (number :value 4.0)
 237                  (function :value fun)
 238                  (regexp :value ".*"))
 239   :group 'gnus-article-signature)
 240
 241 (defcustom gnus-hidden-properties '(invisible t intangible t)
 242   "Property list to use for hiding text."
 243   :type 'sexp
 244   :group 'gnus-article-hiding)
 245
 246 ;; Fixme: This isn't the right thing for mixed graphical and and
 247 ;; non-graphical frames in a session.
 248 (defcustom gnus-article-x-face-command
 249   (if (featurep 'xemacs)
 250       (if (or (gnus-image-type-available-p 'xface)
 251               (gnus-image-type-available-p 'pbm))
 252           'gnus-display-x-face-in-from
 253         "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
 254     (if (gnus-image-type-available-p 'pbm)
 255         'gnus-display-x-face-in-from
 256       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
 257 display -"))
 258   "*String or function to be executed to display an X-Face header.
 259 If it is a string, the command will be executed in a sub-shell
 260 asynchronously.  The compressed face will be piped to this command."
 261   :type `(choice string
 262                  (function-item gnus-display-x-face-in-from)
 263                  function)
 264   :version "21.1"
 265   :group 'gnus-picon
 266   :group 'gnus-article-washing)
 267
 268 (defcustom gnus-article-x-face-too-ugly nil
 269   "Regexp matching posters whose face shouldn't be shown automatically."
 270   :type '(choice regexp (const nil))
 271   :group 'gnus-article-washing)
 272
 273 (defcustom gnus-article-banner-alist nil
 274   "Banner alist for stripping.
 275 For example,
 276      ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 277   :version "21.1"
 278   :type '(repeat (cons symbol regexp))
 279   :group 'gnus-article-washing)
 280
 281 (gnus-define-group-parameter
 282  banner
 283  :variable-document
 284  "Alist of regexps (to match group names) and banner."
 285  :variable-group gnus-article-washing
 286  :parameter-type
 287  '(choice :tag "Banner"
 288           :value nil
 289           (const :tag "Remove signature" signature)
 290           (symbol :tag "Item in `gnus-article-banner-alist'" none)
 291           regexp
 292           (const :tag "None" nil))
 293  :parameter-document
 294  "If non-nil, specify how to remove `banners' from articles.
 295
 296 Symbol `signature' means to remove signatures delimited by
 297 `gnus-signature-separator'.  Any other symbol is used to look up a
 298 regular expression to match the banner in `gnus-article-banner-alist'.
 299 A string is used as a regular expression to match the banner
 300 directly.")
 301
 302 (defcustom gnus-article-address-banner-alist nil
 303   "Alist of mail addresses and banners.
 304 Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
 305 to match a mail address in the From: header, BANNER is one of a symbol
 306 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
 307 If ADDRESS matches author's mail address, it will remove things like
 308 advertisements.  For example:
 309
 310 \((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 311 "
 312   :type '(repeat
 313           (cons
 314            (regexp :tag "Address")
 315            (choice :tag "Banner" :value nil
 316                    (const :tag "Remove signature" signature)
 317                    (symbol :tag "Item in `gnus-article-banner-alist'" none)
 318                    regexp
 319                    (const :tag "None" nil))))
 320   :group 'gnus-article-washing)
 321
 322 (defcustom gnus-emphasis-alist
 323   (let ((format