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

   1 ;;; gnus-cite.el --- parse citations in articles for Gnus
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Per Abhiddenware
   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 (eval-when-compile (require 'cl))
  28 (eval-when-compile
  29   (when (featurep 'xemacs)
  30     (require 'easy-mmode))) ; for `define-minor-mode'
  31
  32 (require 'gnus)
  33 (require 'gnus-range)
  34 (require 'gnus-art)
  35 (require 'message)      ; for message-cite-prefix-regexp
  36
  37 ;;; Customization:
  38
  39 (defgroup gnus-cite nil
  40   "Citation."
  41   :prefix "gnus-cite-"
  42   :link '(custom-manual "(gnus)Article Highlighting")
  43   :group 'gnus-article)
  44
  45 (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
  46   "Format of opened cited text buttons."
  47   :group 'gnus-cite
  48   :type 'string)
  49
  50 (defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n"
  51   "Format of closed cited text buttons."
  52   :group 'gnus-cite
  53   :type 'string)
  54
  55 (defcustom gnus-cited-lines-visible nil
  56   "The number of lines of hidden cited text to remain visible.
  57 Or a pair (cons) of numbers which are the number of lines at the top
  58 and bottom of the text, respectively, to remain visible."
  59   :group 'gnus-cite
  60   :type '(choice (const :tag "none" nil)
  61                  integer
  62                  (cons :tag "Top and Bottom" integer integer)))
  63
  64 (defcustom gnus-cite-parse-max-size 25000
  65   "Maximum article size (in bytes) where parsing citations is allowed.
  66 Set it to nil to parse all articles."
  67   :group 'gnus-cite
  68   :type '(choice (const :tag "all" nil)
  69                  integer))
  70
  71 (defcustom gnus-cite-max-prefix 20
  72   "Maximum possible length for a citation prefix."
  73   :group 'gnus-cite
  74   :type 'integer)
  75
  76 (defcustom gnus-supercite-regexp
  77   (concat "^\\(" message-cite-prefix-regexp "\\)? *"
  78           ">>>>> +\"\\([^\"\n]+\\)\" +==")
  79   "*Regexp matching normal Supercite attribution lines.
  80 The first grouping must match prefixes added by other packages."
  81   :group 'gnus-cite
  82   :type 'regexp)
  83
  84 (defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
  85   "Regexp matching mangled Supercite attribution lines.
  86 The first regexp group should match the Supercite attribution."
  87   :group 'gnus-cite
  88   :type 'regexp)
  89
  90 (defcustom gnus-cite-minimum-match-count 2
  91   "Minimum number of identical prefixes before we believe it's a citation."
  92   :group 'gnus-cite
  93   :type 'integer)
  94
  95 ;; Some Microsoft products put in a citation that extends to the
  96 ;; remainder of the message:
  97 ;;
  98 ;;     -----Original Message-----
  99 ;;     From: ...
 100 ;;     To: ...
 101 ;;     Sent: ...   [date, in non-RFC-2822 format]
 102 ;;     Subject: ...
 103 ;;
 104 ;;     Cited message, with no prefixes
 105 ;;
 106 ;; The four headers are always the same.  But note they are prone to
 107 ;; folding without additional indentation.
 108 ;;
 109 ;; Others use "----- Original Message -----" instead, and properly quote
 110 ;; the body using "> ".  This style is handled without special cases.
 111
 112 (defcustom gnus-cite-attribution-prefix
 113   "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
 114   "*Regexp matching the beginning of an attribution line."
 115   :group 'gnus-cite
 116   :type 'regexp)
 117
 118 (defcustom gnus-cite-attribution-suffix
 119   "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
 120   "*Regexp matching the end of an attribution line.
 121 The text matching the first grouping will be used as a button."
 122   :group 'gnus-cite
 123   :type 'regexp)
 124
 125 (defcustom gnus-cite-unsightly-citation-regexp
 126   "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
 127   "Regexp matching Microsoft-type rest-of-message citations."
 128   :version "22.1"
 129   :group 'gnus-cite
 130   :type 'regexp)
 131
 132 (defcustom gnus-cite-ignore-quoted-from t
 133   "Non-nil means don't regard lines beginning with \">From \" as cited text.
 134 Those lines may have been quoted by MTAs in order not to mix up with
 135 the envelope From line."
 136   :version "22.1"
 137   :group 'gnus-cite
 138   :type 'boolean)
 139
 140 (defface gnus-cite-attribution '((t (:italic t)))
 141   "Face used for attribution lines."
 142   :group 'gnus-cite)
 143 ;; backward-compatibility alias
 144 (put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution)
 145 (put 'gnus-cite-attribution-face 'obsolete-face "22.1")
 146
 147 (defcustom gnus-cite-attribution-face 'gnus-cite-attribution
 148   "Face used for attribution lines.
 149 It is merged with the face for the cited text belonging to the attribution."
 150   :version "22.1"
 151   :group 'gnus-cite
 152   :type 'face)
 153
 154 (defface gnus-cite-1 '((((class color)
 155                          (background dark))
 156                         (:foreground "light blue"))
 157                        (((class color)
 158                          (background light))
 159                         (:foreground "MidnightBlue"))
 160                        (t
 161                         (:italic t)))
 162   "Citation face."
 163   :group 'gnus-cite)
 164 ;; backward-compatibility alias
 165 (put 'gnus-cite-face-1 'face-alias 'gnus-cite-1)
 166 (put 'gnus-cite-face-1 'obsolete-face "22.1")
 167
 168 (defface gnus-cite-2 '((((class color)
 169                          (background dark))
 170                         (:foreground "light cyan"))
 171                        (((class color)
 172                          (background light))
 173                         (:foreground "firebrick"))
 174                        (t
 175                         (:italic t)))
 176   "Citation face."
 177   :group 'gnus-cite)
 178 ;; backward-compatibility alias
 179 (put 'gnus-cite-face-2 'face-alias 'gnus-cite-2)
 180 (put 'gnus-cite-face-2 'obsolete-face "22.1")
 181
 182 (defface gnus-cite-3 '((((class color)