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