(require 'gnus-ems)
(eval-and-compile
- (autoload 'gnus-article-add-button "gnus-vis")
- )
+ (autoload 'gnus-article-add-button "gnus-vis"))
;;; Customization:
+(defvar gnus-cite-parse-max-size 25000
+ "Maximum article size (in bytes) where parsing citations is allowed.
+Set it to nil to parse all articles.")
+
(defvar gnus-cite-prefix-regexp
"^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
"Regexp matching the longest possible citation prefix on a line.")
(defvar gnus-cite-max-prefix 20
- "Maximal possible length for a citation prefix.")
+ "Maximum possible length for a citation prefix.")
(defvar gnus-supercite-regexp
(concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"Regexp matching normal SuperCite attribution lines.
-The first regexp group should match a prefix added by another package.")
+The first grouping must match prefixes added by other packages.")
(defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
"Regexp matching mangled SuperCite attribution lines.
The first regexp group should match the SuperCite attribution.")
(defvar gnus-cite-minimum-match-count 2
- "Minimal number of identical prefix'es before we believe it is a citation.")
+ "Minimum number of identical prefixes before we believe it's a citation.")
-(defvar gnus-cite-face-list
- (if (eq gnus-display-type 'color)
- (if (eq gnus-background-mode 'dark) 'light 'dark)
- '(italic))
- "Faces used for displaying different citations.
-It is either a list of face names, or one of the following special
-values:
+;see gnus-cus.el
+;(defvar gnus-cite-face-list
+; (if (eq gnus-display-type 'color)
+; (if (eq gnus-background-mode 'dark) 'light 'dark)
+; '(italic))
+; "Faces used for displaying different citations.
+;It is either a list of face names, or one of the following special
+;values:
-dark: Create faces from `gnus-face-dark-name-list'.
-light: Create faces from `gnus-face-light-name-list'.
+;dark: Create faces from `gnus-face-dark-name-list'.
+;light: Create faces from `gnus-face-light-name-list'.
-The variable `gnus-make-foreground' determines whether the created
-faces change the foreground or the background colors.")
+;The variable `gnus-make-foreground' determines whether the created
+;faces change the foreground or the background colors.")
(defvar gnus-cite-attribution-prefix "in article\\|in <"
"Regexp matching the beginning of an attribution line.")
-(defvar gnus-cite-attribution-postfix
+(defvar gnus-cite-attribution-suffix
"\\(wrote\\|writes\\|said\\|says\\):[ \t]*$"
"Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button.")
-(defvar gnus-cite-attribution-face 'underline
- "Face used for attribution lines.
-It is merged with the face for the cited text belonging to the attribution.")
-
-(defvar gnus-cite-hide-percentage 50
- "Only hide cited text if it is larger than this percent of the body.")
-
-(defvar gnus-cite-hide-absolute 10
- "Only hide cited text if there is at least this number of cited lines.")
-
-(defvar gnus-face-light-name-list
- '("light blue" "light cyan" "light yellow" "light pink"
- "pale green" "beige" "orange" "magenta" "violet" "medium purple"
- "turquoise")
- "Names of light colors.")
-
-(defvar gnus-face-dark-name-list
- '("dark salmon" "firebrick"
- "dark green" "dark orange" "dark khaki" "dark violet"
- "dark turquoise")
- "Names of dark colors.")
+;see gnus-cus.el
+;(defvar gnus-cite-attribution-face 'underline
+; "Face used for attribution lines.
+;It is merged with the face for the cited text belonging to the attribution.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-hide-percentage 50
+; "Only hide cited text if it is larger than this percent of the body.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-hide-absolute 10
+; "Only hide cited text if there is at least this number of cited lines.")
+
+;see gnus-cus.el
+;(defvar gnus-face-light-name-list
+; '("light blue" "light cyan" "light yellow" "light pink"
+; "pale green" "beige" "orange" "magenta" "violet" "medium purple"
+; "turquoise")
+; "Names of light colors.")
+
+;see gnus-cus.el
+;(defvar gnus-face-dark-name-list
+; '("dark salmon" "firebrick"
+; "dark green" "dark orange" "dark khaki" "dark violet"
+; "dark turquoise")
+; "Names of dark colors.")
;;; Internal Variables:
(defvar gnus-article-length nil)
;; Length of article last time we parsed it.
+;; BUG! KLUDGE! UGLY! FIX ME!
(defvar gnus-cite-prefix-alist nil)
;; Alist of citation prefixes.
;;; Commands:
-(defun gnus-article-highlight-citation ()
+(defun gnus-article-highlight-citation (&optional force)
"Highlight cited text.
Each citation in the article will be highlighted with a different face.
The faces are taken from `gnus-cite-face-list'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
lines matches `gnus-cite-prefix-regexp' with the same prefix.
-Lines matching `gnus-cite-attribution-postfix' and perhaps
+Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
- (interactive)
+ (interactive (list 'force))
;; Create dark or light faces if necessary.
(cond ((eq gnus-cite-face-list 'light)
(setq gnus-cite-face-list
(mapcar 'gnus-make-face gnus-face-dark-name-list))))
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
(faces gnus-cite-face-list)
face (cdr (assoc prefix face-alist)))
;; Add attribution button.
(goto-line number)
- (if (re-search-forward gnus-cite-attribution-postfix
+ (if (re-search-forward gnus-cite-attribution-suffix
(save-excursion (end-of-line 1) (point))
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
skip (gnus-cite-find-prefix number))
(gnus-cite-add-face number skip gnus-cite-attribution-face)))))
-(defun gnus-article-hide-citation ()
+(defun gnus-article-hide-citation (&optional force)
"Hide all cited text except attribution lines.
See the documentation for `gnus-article-highlight-citation'."
- (interactive)
+ (interactive (list 'force))
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
(inhibit-point-motion-hooks t)
(interactive (list 'force))
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe force)
(goto-char (point-min))
- (search-forward "\n\n")
+ (search-forward "\n\n" nil t)
(let ((start (point))
(atts gnus-cite-attribution-alist)
(buffer-read-only nil)
;;; Internal functions:
-(defun gnus-cite-parse-maybe ()
+(defun gnus-cite-parse-maybe (&optional force)
;; Parse if the buffer has changes since last time.
(if (eq gnus-article-length (- (point-max) (point-min)))
()
- (setq gnus-article-length (- (point-max) (point-min)))
- (gnus-cite-parse)))
+ ;;Reset parser information.
+ (setq gnus-cite-prefix-alist nil
+ gnus-cite-attribution-alist nil
+ gnus-cite-loose-prefix-alist nil
+ gnus-cite-loose-attribution-alist nil)
+ ;; Parse if not too large.
+ (if (and (not force)
+ gnus-cite-parse-max-size
+ (> (buffer-size) gnus-cite-parse-max-size))
+ ()
+ (setq gnus-article-length (- (point-max) (point-min)))
+ (gnus-cite-parse))))
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
- (setq gnus-cite-prefix-alist nil
- gnus-cite-attribution-alist nil
- gnus-cite-loose-prefix-alist nil
- gnus-cite-loose-attribution-alist nil)
+
;; Parse current buffer searching for citation prefixes.
(goto-char (point-min))
(or (search-forward "\n\n" nil t)
(setq gnus-cite-prefix-alist
(cons entry gnus-cite-prefix-alist)))
(t
- (setq gnus-cite-prefix-alist (cons entry gnus-cite-prefix-alist))
+ (setq gnus-cite-prefix-alist (cons entry
+ gnus-cite-prefix-alist))
;; Remove articles from other prefixes.
(let ((loop alist)
current)
;; Parse current buffer searching for attribution lines.
(goto-char (point-min))
- (search-forward "\n\n")
- (while (re-search-forward gnus-cite-attribution-postfix (point-max) t)
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(wrote (count-lines (point-min) end))
(beginning-of-line 0)
(point))
t)
- (not (re-search-forward gnus-cite-attribution-postfix
+ (not (re-search-forward gnus-cite-attribution-suffix
start t))
(count-lines (point-min) (1+ (point)))))))
(if (eq wrote in)
gnus-cite-loose-attribution-alist))))
;; Find exact supercite citations.
(gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (if tag
- (concat "\\`" (regexp-quote prefix) "[ \t]*"
- (regexp-quote tag) ">"))))
+ (lambda (prefix tag)
+ (if tag
+ (concat "\\`"
+ (regexp-quote prefix) "[ \t]*"
+ (regexp-quote tag) ">"))))
;; Find loose supercite citations after attributions.
(gnus-cite-match-attributions 'small t
- (lambda (prefix tag)
- (if tag (concat "\\<" (regexp-quote tag) "\\>"))))
+ (lambda (prefix tag)
+ (if tag (concat "\\<"
+ (regexp-quote tag)
+ "\\>"))))
;; Find loose supercite citations anywhere.
(gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (if tag (concat "\\<" (regexp-quote tag) "\\>"))))
+ (lambda (prefix tag)
+ (if tag (concat "\\<"
+ (regexp-quote tag)
+ "\\>"))))
;; Find nested citations after attributions.
(gnus-cite-match-attributions 'small-if-unique t
- (lambda (prefix tag)
- (concat "\\`" (regexp-quote prefix) ".+")))
+ (lambda (prefix tag)
+ (concat "\\`" (regexp-quote prefix) ".+")))
;; Find nested citations anywhere.
(gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (concat "\\`" (regexp-quote prefix) ".+")))
+ (lambda (prefix tag)
+ (concat "\\`" (regexp-quote prefix) ".+")))
;; Remove loose prefixes with too few lines.
(let ((alist gnus-cite-loose-prefix-alist)
entry)
(setq gnus-cite-attribution-alist
(cons (cons in (car best)) gnus-cite-attribution-alist)))
(if (memq best gnus-cite-loose-prefix-alist)
- (let ((loop gnus-cite-prefix-alist)
- (numbers (cdr best))
- current)
- (setq gnus-cite-loose-prefix-alist
- (delq best gnus-cite-loose-prefix-alist))
- (while loop
- (setq current (car loop)
- loop (cdr loop))
- (if (eq current best)
- ()
- (setcdr current (gnus-set-difference (cdr current) numbers))
- (if (null (cdr current))
- (setq gnus-cite-loose-prefix-alist
- (delq current gnus-cite-loose-prefix-alist)
- atts (delq current atts)))))))))))
+ (let ((loop gnus-cite-prefix-alist)
+ (numbers (cdr best))
+ current)
+ (setq gnus-cite-loose-prefix-alist
+ (delq best gnus-cite-loose-prefix-alist))
+ (while loop
+ (setq current (car loop)
+ loop (cdr loop))
+ (if (eq current best)
+ ()
+ (setcdr current (gnus-set-difference (cdr current) numbers))
+ (if (null (cdr current))
+ (setq gnus-cite-loose-prefix-alist
+ (delq current gnus-cite-loose-prefix-alist)
+ atts (delq current atts)))))))))))
(defun gnus-cite-find-loose (prefix)
;; Return a list of loose attribution lines prefixed by PREFIX.
projects / gnus / blobdiff