;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: news, mail
;;; Code:
-(require 'gnus-load)
(require 'gnus)
(require 'gnus-art)
(require 'gnus-range)
(defgroup gnus-cite nil
"Citation."
- :group 'article)
-
+ :prefix "gnus-cite-"
+ :link '(custom-manual "(gnus)Article Highlighting")
+ :group 'gnus-article)
+
+(defcustom gnus-cite-reply-regexp
+ "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
+ "If headers match this regexp it is reasonable to believe that
+article has citations."
+ :group 'gnus-cite
+ :type 'string)
+
+(defcustom gnus-cite-always-check nil
+ "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)))
(defcustom gnus-cited-text-button-line-format "%(%{[...]%}%)\n"
"Format of cited text buttons."
:type '(choice (const :tag "all" nil)
integer))
-(defcustom gnus-cite-prefix-regexp
+(defcustom gnus-cite-prefix-regexp
"^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
"Regexp matching the longest possible citation prefix on a line."
:group 'gnus-cite
:group 'gnus-cite
:type 'integer)
-(defcustom gnus-supercite-regexp
+(defcustom gnus-supercite-regexp
(concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"Regexp matching normal Supercite attribution lines.
:group 'gnus-cite
:type 'regexp)
-(defface gnus-cite-attribution-face '((t
+(defface gnus-cite-attribution-face '((t
(:underline t)))
"Face used for attribution lines.")
(((class color)
(background light))
(:foreground "MidnightBlue"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "firebrick"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark green"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "OrangeRed"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark khaki"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark violet"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "SteelBlue4"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "magenta"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "violet"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "medium purple"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "turquoise"))
- (t
+ (t
(:italic t)))
"Citation face.")
-(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
+(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)
- "List of faces used for highlighting citations.
+ "List of faces used for highlighting citations.
When there are citations from multiple articles in the same message,
Gnus will try to give each citation from each article its own face.
(defvar gnus-cite-article nil)
(defvar gnus-cite-prefix-alist nil)
-;; Alist of citation prefixes.
+;; Alist of citation prefixes.
;; The cdr is a list of lines with that prefix.
(defvar gnus-cite-attribution-alist nil)
;; PREFIX: Is the citation prefix of the attribution line(s), and
;; TAG: Is a Supercite tag, if any.
-(defvar gnus-cited-text-button-line-format-alist
- `((?b beg ?d)
- (?e end ?d)
+(defvar gnus-cited-text-button-line-format-alist
+ `((?b (marker-position beg) ?d)
+ (?e (marker-position end) ?d)
(?l (- end beg) ?d)))
(defvar gnus-cited-text-button-line-format-spec nil)
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 `gnus-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
face (cdr (assoc prefix face-alist)))
;; Add attribution button.
(goto-line number)
- (when (re-search-forward gnus-cite-attribution-suffix
+ (when (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)
(goto-char (point-min))
(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)
(push (cons (point-marker) "") marks)
+ ;; Find the end of the body.
(goto-char (point-max))
- (article-search-signature)
+ (gnus-article-search-signature)
(push (cons (point-marker) "") marks)
+ ;; Sort the marks.
(setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
- (let* ((omarks marks))
+ (let ((omarks marks))
(setq marks nil)
(while (cdr omarks)
(if (= (caar omarks) (caadr omarks))
(push (car omarks) marks))
(unless (equal (cdadr omarks) "")
(push (cadr omarks) marks))
- (setq omarks (cdr omarks)))
+ (unless (and (equal (cdar omarks) "")
+ (equal (cdadr omarks) "")
+ (not (cddr omarks)))
+ (setq omarks (cdr omarks))))
(push (car omarks) marks))
(setq omarks (cdr omarks)))
(when (car omarks)
(setcdr m (cdddr m))
(setq m (cdr m))))
marks))))
-
-(defun gnus-article-fill-cited-article (&optional force)
- "Do word wrapping in the current article."
- (interactive (list t))
+
+(defun gnus-article-fill-cited-article (&optional force width)
+ "Do word wrapping in the current article.
+If WIDTH (the numerical prefix), use that text width when filling."
+ (interactive (list t current-prefix-arg))
(save-excursion
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
- (adaptive-fill-mode nil))
+ (adaptive-fill-mode nil)
+ (filladapt-mode nil)
+ (fill-column (if width (prefix-numeric-value width) fill-column)))
(save-restriction
(while (cdr marks)
(widen)
See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (append (article-hidden-arg) (list 'force)))
- (setq gnus-cited-text-button-line-format-spec
- (gnus-parse-format gnus-cited-text-button-line-format
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (setq gnus-cited-text-button-line-format-spec
+ (gnus-parse-format gnus-cited-text-button-line-format
gnus-cited-text-button-line-format-alist t))
(save-excursion
(set-buffer gnus-article-buffer)
(cond
- ((article-check-hidden-text 'cite arg)
+ ((gnus-article-check-hidden-text 'cite arg)
t)
- ((article-text-type-exists-p 'cite)
+ ((gnus-article-text-type-exists-p 'cite)
(let ((buffer-read-only nil))
- (article-hide-text-of-type 'cite)))
+ (gnus-article-hide-text-of-type 'cite)))
(t
(let ((buffer-read-only nil)
(marks (gnus-dissect-cited-text))
end nil)
(while (and marks (string= (cdar marks) ""))
(setq marks (cdr marks)))
- (when marks
+ (when marks
(setq beg (caar marks)))
(while (and marks (not (string= (cdar marks) "")))
(setq marks (cdr marks)))
cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
- (interactive (append (article-hidden-arg) (list 'force)))
- (unless (article-check-hidden-text 'cite arg)
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (unless (gnus-article-check-hidden-text 'cite arg)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-cite-parse-maybe force)
(hiden 0)
total)
(goto-char (point-max))
- (article-search-signature)
+ (gnus-article-search-signature)
(setq total (count-lines start (point)))
(while atts
(setq hiden (+ hiden (length (cdr (assoc (cdar atts)
total (cdr total))
(goto-line hiden)
(unless (assq hiden gnus-cite-attribution-alist)
- (gnus-add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
gnus-hidden-properties))))))))))
()
(setq gnus-cite-article (cons (car gnus-article-current)
(cdr gnus-article-current)))
- (gnus-cite-parse))))
+ (gnus-cite-parse-wrapper))))
-(defun gnus-cite-parse ()
- ;; Parse and connect citation prefixes and attribution lines.
-
- ;; Parse current buffer searching for citation prefixes.
+(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)))))
+
+(defun gnus-cite-parse ()
+ ;; Parse and connect citation prefixes and attribution lines.
+
+ ;; Parse current buffer searching for citation prefixes.
(let ((line (1+ (count-lines (point-min) (point))))
(case-fold-search t)
(max (save-excursion
(goto-char (point-max))
- (article-search-signature)
+ (gnus-article-search-signature)
(point)))
alist entry start begin end numbers prefix)
;; Get all potential prefixes in `alist'.
prefix (buffer-substring begin end))
(gnus-set-text-properties 0 (length prefix) nil prefix)
(setq entry (assoc prefix alist))
- (if entry
+ (if entry
(setcdr entry (cons line (cdr entry)))
(push (list prefix line) alist))
(goto-char begin))
;; Too few lines with this prefix. We keep it a bit
;; longer in case it is an exact match for an attribution
;; line, but we don't remove the line from other
- ;; prefixes.
+ ;; prefixes.
(push entry gnus-cite-prefix-alist))
(t
(push entry
(while loop
(setq current (car loop)
loop (cdr loop))
- (setcdr current
- (gnus-set-difference (cdr current) numbers))))))))
+ (setcdr current
+ (gnus-set-difference (cdr current) numbers)))))))))
+
+(defun gnus-cite-parse-attributions ()
+ (let (al-alist)
+ ;; Parse attributions
+ (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))
+ (prefix (gnus-cite-find-prefix wrote))
+ ;; Check previous line for an attribution leader.
+ (tag (progn
+ (beginning-of-line 1)
+ (when (looking-at gnus-supercite-secondary-regexp)
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (in (progn
+ (goto-char start)
+ (and (re-search-backward gnus-cite-attribution-prefix
+ (save-excursion
+ (beginning-of-line 0)
+ (point))
+ t)
+ (not (re-search-forward gnus-cite-attribution-suffix
+ start t))
+ (count-lines (point-min) (1+ (point)))))))
+ (when (eq wrote in)
+ (setq in nil))
+ (goto-char end)
+ ;; don't add duplicates
+ (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
+ (1+ (point)))
+ end)))
+ (if (not (assoc al al-alist))
+ (progn
+ (push (list wrote in prefix tag)
+ gnus-cite-loose-attribution-alist)
+ (push (cons al t) al-alist))))))))
+
+(defun gnus-cite-connect-attributions ()
+ ;; Connect attributions to citations
+
;; No citations have been connected to attribution lines yet.
(setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
;; Parse current buffer searching for attribution lines.
- (goto-char (point-min))
- (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))
- (prefix (gnus-cite-find-prefix wrote))
- ;; Check previous line for an attribution leader.
- (tag (progn
- (beginning-of-line 1)
- (when (looking-at gnus-supercite-secondary-regexp)
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (in (progn
- (goto-char start)
- (and (re-search-backward gnus-cite-attribution-prefix
- (save-excursion
- (beginning-of-line 0)
- (point))
- t)
- (not (re-search-forward gnus-cite-attribution-suffix
- start t))
- (count-lines (point-min) (1+ (point)))))))
- (when (eq wrote in)
- (setq in nil))
- (goto-char end)
- (push (list wrote in prefix tag)
- gnus-cite-loose-attribution-alist)))
;; Find exact supercite citations.
(gnus-cite-match-attributions 'small nil
(lambda (prefix tag)
(when tag
- (concat "\\`"
- (regexp-quote prefix) "[ \t]*"
+ (concat "\\`"
+ (regexp-quote prefix) "[ \t]*"
(regexp-quote tag) ">"))))
;; Find loose supercite citations after attributions.
(gnus-cite-match-attributions 'small t
;; If FUN is non-nil, it will be called with the arguments (WROTE
;; PREFIX TAG) and expected to return a regular expression. Only
;; citations whose prefix matches the regular expression will be
- ;; considered.
- ;;
+ ;; considered.
+ ;;
;; WROTE is the attribution line number.
;; PREFIX is the attribution line prefix.
;; TAG is the Supercite tag on the attribution line.
((eq sort 'first) nil)
(t (< (length (gnus-cite-find-loose prefix)) 2)))
limit (if after wrote -1)
- smallest 1000000
+ smallest 1000000
best nil)
(let ((cites gnus-cite-loose-prefix-alist)
cite candidate numbers first compare)
gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
- (gnus-add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
gnus-hidden-properties))))))))
projects / gnus / blobdiff