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 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (require 'gnus)
  31 (require 'gnus-sum)
  32 (require 'gnus-spec)
  33 (require 'gnus-int)
  34 (require 'mm-bodies)
  35 (require 'mail-parse)
  36 (require 'mm-decode)
  37 (require 'mm-view)
  38 (require 'wid-edit)
  39 (require 'mm-uu)
  40
  41 (defgroup gnus-article nil
  42   "Article display."
  43   :link '(custom-manual "(gnus)The Article Buffer")
  44   :group 'gnus)
  45
  46 (defgroup gnus-article-treat nil
  47   "Treating article parts."
  48   :link '(custom-manual "(gnus)Article Hiding")
  49   :group 'gnus-article)
  50
  51 (defgroup gnus-article-hiding nil
  52   "Hiding article parts."
  53   :link '(custom-manual "(gnus)Article Hiding")
  54   :group 'gnus-article)
  55
  56 (defgroup gnus-article-highlight nil
  57   "Article highlighting."
  58   :link '(custom-manual "(gnus)Article Highlighting")
  59   :group 'gnus-article
  60   :group 'gnus-visual)
  61
  62 (defgroup gnus-article-signature nil
  63   "Article signatures."
  64   :link '(custom-manual "(gnus)Article Signature")
  65   :group 'gnus-article)
  66
  67 (defgroup gnus-article-headers nil
  68   "Article headers."
  69   :link '(custom-manual "(gnus)Hiding Headers")
  70   :group 'gnus-article)
  71
  72 (defgroup gnus-article-washing nil
  73   "Special commands on articles."
  74   :link '(custom-manual "(gnus)Article Washing")
  75   :group 'gnus-article)
  76
  77 (defgroup gnus-article-emphasis nil
  78   "Fontisizing articles."
  79   :link '(custom-manual "(gnus)Article Fontisizing")
  80   :group 'gnus-article)
  81
  82 (defgroup gnus-article-saving nil
  83   "Saving articles."
  84   :link '(custom-manual "(gnus)Saving Articles")
  85   :group 'gnus-article)
  86
  87 (defgroup gnus-article-mime nil
  88   "Worshiping the MIME wonder."
  89   :link '(custom-manual "(gnus)Using MIME")
  90   :group 'gnus-article)
  91
  92 (defgroup gnus-article-buttons nil
  93   "Pushable buttons in the article buffer."
  94   :link '(custom-manual "(gnus)Article Buttons")
  95   :group 'gnus-article)
  96
  97 (defgroup gnus-article-various nil
  98   "Other article options."
  99   :link '(custom-manual "(gnus)Misc Article")
 100   :group 'gnus-article)
 101
 102 (defcustom gnus-ignored-headers
 103   '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
 104     "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
 105     "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
 106     "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
 107     "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
 108     "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
 109     "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
 110     "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
 111     "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
 112     "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
 113     "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
 114     "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
 115     "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:"
 116     "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
 117     "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
 118     "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
 119     "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
 120     "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:"
 121     "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:"
 122     "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:"
 123     "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:"
 124     "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:"
 125     "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:"
 126     "^List-[A-Za-z]+:" "^X-Listprocessor-Version:"
 127     "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:"
 128     "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:"
 129     "^X-Received:" "^Content-length:" "X-precedence:")
 130   "*All headers that start with this regexp will be hidden.
 131 This variable can also be a list of regexps of headers to be ignored.
 132 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 133   :type '(choice :custom-show nil
 134                  regexp
 135                  (repeat regexp))
 136   :group 'gnus-article-hiding)
 137
 138 (defcustom gnus-visible-headers
 139   "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
 140   "*All headers that do not match this regexp will be hidden.
 141 This variable can also be a list of regexp of headers to remain visible.
 142 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 143   :type '(repeat :value-to-internal (lambda (widget value)
 144                                       (custom-split-regexp-maybe value))
 145                  :match (lambda (widget value)
 146                           (or (stringp value)
 147                               (widget-editable-list-match widget value)))
 148                  regexp)
 149   :group 'gnus-article-hiding)
 150
 151 (defcustom gnus-sorted-header-list
 152   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 153     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 154   "*This variable is a list of regular expressions.
 155 If it is non-nil, headers that match the regular expressions will
 156 be placed first in the article buffer in the sequence specified by
 157 this list."
 158   :type '(repeat regexp)
 159   :group 'gnus-article-hiding)
 160
 161 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 162   "Headers that are only to be displayed if they have interesting data.
 163 Possible values in this list are `empty', `newsgroups', `followup-to',
 164 `reply-to', `date', `long-to', and `many-to'."
 165   :type '(set (const :tag "Headers with no content." empty)
 166               (const :tag "Newsgroups with only one group." newsgroups)
 167               (const :tag "Followup-to identical to newsgroups." followup-to)
 168               (const :tag "Reply-to identical to from." reply-to)
 169               (const :tag "Date less than four days old." date)
 170               (const :tag "Very long To and/or Cc header." long-to)
 171               (const :tag "Multiple To and/or Cc headers." many-to))
 172   :group 'gnus-article-hiding)
 173
 174 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 175   "Regexp matching signature separator.
 176 This can also be a list of regexps.  In that case, it will be checked
 177 from head to tail looking for a separator.  Searches will be done from
 178 the end of the buffer."
 179   :type '(repeat string)
 180   :group 'gnus-article-signature)
 181
 182 (defcustom gnus-signature-limit nil
 183   "Provide a limit to what is considered a signature.
 184 If it is a number, no signature may not be longer (in characters) than
 185 that number.  If it is a floating point number, no signature may be
 186 longer (in lines) than that number.  If it is a function, the function
 187 will be called without any parameters, and if it returns nil, there is
 188 no signature in the buffer.  If it is a string, it will be used as a
 189 regexp.  If it matches, the text in question is not a signature."
 190   :type '(choice (integer :value 200)
 191                  (number :value 4.0)
 192                  (function :value fun)
 193                  (regexp :value ".*"))
 194   :group 'gnus-article-signature)
 195
 196 (defcustom gnus-hidden-properties '(invisible t intangible t)
 197   "Property list to use for hiding text."
 198   :type 'sexp
 199   :group 'gnus-article-hiding)
 200
 201 (defcustom gnus-article-x-face-command
 202   (if (and (fboundp 'image-type-available-p)
 203            (or (image-type-available-p 'xpm)
 204                (image-type-available-p 'xbm)))
 205       'gnus-article-display-xface
 206     "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -")
 207   "*String or function to be executed to display an X-Face header.
 208 If it is a string, the command will be executed in a sub-shell
 209 asynchronously.  The compressed face will be piped to this command."
 210   :type '(choice string
 211                  (function-item gnus-article-display-xface)
 212                  function)
 213   :group 'gnus-article-washing)
 214
 215 (defcustom gnus-article-x-face-too-ugly nil
 216   "Regexp matching posters whose face shouldn't be shown automatically."
 217   :type '(choice regexp (const nil))
 218   :group 'gnus-article-washing)
 219
 220 (defcustom gnus-emphasis-alist
 221   (let ((format
 222          "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
 223         (types
 224          '(("_" "_" underline)
 225            ("/" "/" italic)
 226            ("\\*" "\\*" bold)
 227            ("_/" "/_" underline-italic)
 228            ("_\\*" "\\*_" underline-bold)
 229            ("\\*/" "/\\*" bold-italic)
 230            ("_\\*/" "/\\*_" underline-bold-italic))))
 231     `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
 232        2 3 gnus-emphasis-underline)
 233       ,@(mapcar
 234          (lambda (spec)
 235            (list
 236             (format format (car spec) (cadr spec))
 237             2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
 238          types)))
 239   "*Alist that says how to fontify certain phrases.
 240 Each item looks like this:
 241
 242   (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
 243
 244 The first element is a regular expression to be matched.  The second
 245 is a number that says what regular expression grouping used to find
 246 the entire emphasized word.  The third is a number that says what
 247 regexp grouping should be displayed and highlighted.  The fourth
 248 is the face used for highlighting."
 249   :type '(repeat (list :value ("" 0 0 default)
 250                        regexp
 251                        (integer :tag "Match group")
 252                        (integer :tag "Emphasize group")
 253                        face))
 254   :group 'gnus-article-emphasis)
 255
 256 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
 257   "A regexp to describe whitespace which should not be emphasized.
 258 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 259 The former avoids underlining of leading and trailing whitespace,
 260 and the latter avoids underlining any whitespace at all."
 261   :group 'gnus-article-emphasis