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

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