;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Per Abhiddenware; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
(require 'gnus)
(require 'gnus-art)
(require 'gnus-range)
+(require 'message) ; for message-cite-prefix-regexp
;;; Customization:
:type 'string)
(defcustom gnus-cite-always-check nil
- "Check article always for citations. Set it t to check all articles."
+ "Check article always for citations. Set it t to check all articles."
:group 'gnus-cite
:type '(choice (const :tag "no" nil)
- (const :tag "yes" t)))
+ (const :tag "yes" t)))
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
"Format of opened cited text buttons."
:type 'string)
(defcustom gnus-cited-lines-visible nil
- "The number of lines of hidden cited text to remain visible."
+ "The number of lines of hidden cited text to remain visible.
+Or a pair (cons) of numbers which are the number of lines at the top
+and bottom of the text, respectively, to remain visible."
:group 'gnus-cite
:type '(choice (const :tag "none" nil)
- integer))
+ integer
+ (cons :tag "Top and Bottom" integer integer)))
(defcustom gnus-cite-parse-max-size 25000
"Maximum article size (in bytes) where parsing citations is allowed.
:type '(choice (const :tag "all" nil)
integer))
-(defcustom gnus-cite-prefix-regexp
- "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
- "*Regexp matching the longest possible citation prefix on a line."
- :group 'gnus-cite
- :type 'regexp)
-
(defcustom gnus-cite-max-prefix 20
"Maximum possible length for a citation prefix."
:group 'gnus-cite
:type 'integer)
(defcustom gnus-supercite-regexp
- (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
+ (concat "^\\(" message-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"*Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
:type 'integer)
(defcustom gnus-cite-attribution-prefix
- "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),"
+ "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----"
"*Regexp matching the beginning of an attribution line."
:group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-attribution-suffix
- "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ \t]*$"
+ "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$"
"*Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group 'gnus-cite
(defcustom gnus-cite-face-list
'(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
- gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
- gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
+ gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
+ gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
"*List of faces used for highlighting citations.
When there are citations from multiple articles in the same message,
corresponding citation merged with `gnus-cite-attribution-face'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `gnus-cite-prefix-regexp' with the same prefix.
+lines matches `message-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
skip (gnus-cite-find-prefix number)
face (cdr (assoc prefix face-alist)))
;; Add attribution button.
- (goto-line number)
+ (goto-char (point-min))
+ (forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
(save-excursion (end-of-line 1) (point))
t)
"Dissect the article buffer looking for cited text."
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe nil t)
(let ((alist gnus-cite-prefix-alist)
prefix numbers number marks m)
;; Loop through citation prefixes.
(forward-line (1- number))
(push (cons (point-marker) prefix) marks)))
;; Skip to the beginning of the body.
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(push (cons (point-marker) "") marks)
;; Find the end of the body.
(goto-char (point-max))
(fill-column (if width (prefix-numeric-value width) fill-column)))
(save-restriction
(while (cdr marks)
- (widen)
(narrow-to-region (caar marks) (caadr marks))
(let ((adaptive-fill-regexp
(concat "^" (regexp-quote (cdar marks)) " *"))
;; Skip past lines we want to leave visible.
(when (and beg end gnus-cited-lines-visible)
(goto-char beg)
- (forward-line gnus-cited-lines-visible)
+ (forward-line (if (consp gnus-cited-lines-visible)
+ (car gnus-cited-lines-visible)
+ gnus-cited-lines-visible))
(if (>= (point) end)
(setq beg nil)
- (setq beg (point-marker))))
+ (setq beg (point-marker))
+ (when (consp gnus-cited-lines-visible)
+ (goto-char end)
+ (forward-line (- (cdr gnus-cited-lines-visible)))
+ (if (<= (point) beg)
+ (setq beg nil)
+ (setq end (point-marker))))))
(when (and beg end)
;; We use markers for the end-points to facilitate later
;; wrapping and mangling of text.
(defun gnus-article-toggle-cited-text (args)
"Toggle hiding the text in REGION."
(let* ((region (car args))
+ (beg (car region))
+ (end (cdr region))
(start (cadr args))
(hidden
(text-property-any
- (car region) (1- (cdr region))
+ beg (1- end)
(car gnus-hidden-properties) (cadr gnus-hidden-properties)))
(inhibit-point-motion-hooks t)
buffer-read-only)
(funcall
(if hidden
'remove-text-properties 'gnus-add-text-properties)
- (car region) (cdr region) gnus-hidden-properties)
+ beg end gnus-hidden-properties)
(save-excursion
(goto-char start)
(gnus-delete-line)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-cite-parse-maybe force)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(let ((start (point))
(atts gnus-cite-attribution-alist)
(buffer-read-only nil)
(while total
(setq hidden (car total)
total (cdr total))
- (goto-line hidden)
+ (goto-char (point-min))
+ (forward-line (1- hidden))
(unless (assq hidden gnus-cite-attribution-alist)
(gnus-add-text-properties
(point) (progn (forward-line 1) (point))
;;; Internal functions:
-(defun gnus-cite-parse-maybe (&optional force)
- ;; Parse if the buffer has changes since last time.
- (if (and (not force)
- (equal gnus-cite-article gnus-article-current))
+(defun gnus-cite-parse-maybe (&optional force no-overlay)
+ "Always parse the buffer."
+ (gnus-cite-localize)
+ ;;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)
+ (unless no-overlay
+ (gnus-cite-delete-overlays))
+ ;; Parse if not too large.
+ (if (and gnus-cite-parse-max-size
+ (> (buffer-size) gnus-cite-parse-max-size))
()
- (gnus-cite-localize)
- ;;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)
- (while gnus-cite-overlay-list
- (gnus-delete-overlay (pop gnus-cite-overlay-list)))
- ;; Parse if not too large.
- (if (and (not force)
- gnus-cite-parse-max-size
- (> (buffer-size) gnus-cite-parse-max-size))
- ()
- (setq gnus-cite-article (cons (car gnus-article-current)
- (cdr gnus-article-current)))
- (gnus-cite-parse-wrapper))))
+ (setq gnus-cite-article (cons (car gnus-article-current)
+ (cdr gnus-article-current)))
+ (gnus-cite-parse-wrapper)))
+
+(defun gnus-cite-delete-overlays ()
+ (dolist (overlay gnus-cite-overlay-list)
+ (when (or (not (gnus-overlay-end overlay))
+ (and (>= (gnus-overlay-end overlay) (point-min))
+ (<= (gnus-overlay-end overlay) (point-max))))
+ (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
+ (gnus-delete-overlay overlay))))
(defun gnus-cite-parse-wrapper ()
- ;; Wrap chopped gnus-cite-parse
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max)))
- (save-excursion
- (gnus-cite-parse-attributions))
- ;; Try to avoid check citation if there is no reason to believe
- ;; that article has citations
- (if (or gnus-cite-always-check
- (save-excursion
- (re-search-backward gnus-cite-reply-regexp nil t))
- gnus-cite-loose-attribution-alist)
- (progn (save-excursion
- (gnus-cite-parse))
- (save-excursion
- (gnus-cite-connect-attributions)))))
+ ;; Wrap chopped gnus-cite-parse.
+ (article-goto-body)
+ (let ((inhibit-point-motion-hooks t))
+ (save-excursion
+ (gnus-cite-parse-attributions))
+ (save-excursion
+ (gnus-cite-parse))
+ (save-excursion
+ (gnus-cite-connect-attributions))))
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
(goto-char (point-max))
(gnus-article-search-signature)
(point)))
- alist entry start begin end numbers prefix)
+ (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)"))
+ alist entry start begin end numbers prefix guess-limit)
;; Get all potential prefixes in `alist'.
(while (< (point) max)
;; Each line.
(setq begin (point)
+ guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
end (progn (beginning-of-line 2) (point))
start end)
(goto-char begin)
;; Ignore standard Supercite attribution prefix.
- (when (looking-at gnus-supercite-regexp)
+ (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
+ (looking-at gnus-supercite-regexp))
(if (match-end 1)
(setq end (1+ (match-end 1)))
(setq end (1+ begin))))
;; Ignore very long prefixes.
- (when (> end (+ (point) gnus-cite-max-prefix))
- (setq end (+ (point) gnus-cite-max-prefix)))
- (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
+ (when (> end (+ begin gnus-cite-max-prefix))
+ (setq end (+ begin gnus-cite-max-prefix)))
+ (while (re-search-forward prefix-regexp (1- end) t)
;; Each prefix.
(setq end (match-end 0)
prefix (buffer-substring begin end))
(when face
(let ((inhibit-point-motion-hooks t)
from to overlay)
- (goto-line number)
- (unless (eobp) ; Sometimes things become confused.
+ (goto-char (point-min))
+ (when (zerop (forward-line (1- number)))
(forward-char (length prefix))
(skip-chars-forward " \t")
(setq from (point))
(defun gnus-cite-toggle (prefix)
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe nil t)
(let ((buffer-read-only nil)
(numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
(inhibit-point-motion-hooks t)
(while numbers
(setq number (car numbers)
numbers (cdr numbers))
- (goto-line number)
+ (goto-char (point-min))
+ (forward-line (1- number))
(cond ((get-text-property (point) 'invisible)
(remove-text-properties (point) (progn (forward-line 1) (point))
gnus-hidden-properties))
(provide 'gnus-cite)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; gnus-cite.el ends here