Lines Matching +defs:gnus +defs:article +defs:hide +defs:citation
0 ;;; gnus-cite.el --- parse citations in articles for Gnus
31 (require 'gnus)
32 (require 'gnus-range)
33 (require 'gnus-art)
38 (defgroup gnus-cite nil
40 :prefix "gnus-cite-"
41 :link '(custom-manual "(gnus)Article Highlighting")
42 :group 'gnus-article)
44 (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
46 :group 'gnus-cite
49 (defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n"
51 :group 'gnus-cite
54 (defcustom gnus-cited-lines-visible nil
58 :group 'gnus-cite
63 (defcustom gnus-cite-parse-max-size 25000
64 "Maximum article size (in bytes) where parsing citations is allowed.
66 :group 'gnus-cite
70 (defcustom gnus-cite-max-prefix 20
71 "Maximum possible length for a citation prefix."
72 :group 'gnus-cite
75 (defcustom gnus-supercite-regexp
80 :group 'gnus-cite
83 (defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
86 :group 'gnus-cite
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
94 ;; Some Microsoft products put in a citation that extends to the
111 (defcustom gnus-cite-attribution-prefix
112 "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
114 :group 'gnus-cite
117 (defcustom gnus-cite-attribution-suffix
121 :group 'gnus-cite
124 (defcustom gnus-cite-unsightly-citation-regexp
128 :group 'gnus-cite
131 (defcustom gnus-cite-ignore-quoted-from t
136 :group 'gnus-cite
139 (defface gnus-cite-attribution '((t (:italic t)))
141 :group 'gnus-cite)
143 (put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution)
145 (defcustom gnus-cite-attribution-face 'gnus-cite-attribution
149 :group 'gnus-cite
152 (defface gnus-cite-1 '((((class color)
161 :group 'gnus-cite)
163 (put 'gnus-cite-face-1 'face-alias 'gnus-cite-1)
165 (defface gnus-cite-2 '((((class color)
174 :group 'gnus-cite)
176 (put 'gnus-cite-face-2 'face-alias 'gnus-cite-2)
178 (defface gnus-cite-3 '((((class color)
187 :group 'gnus-cite)
189 (put 'gnus-cite-face-3 'face-alias 'gnus-cite-3)
191 (defface gnus-cite-4 '((((class color)
200 :group 'gnus-cite)
202 (put 'gnus-cite-face-4 'face-alias 'gnus-cite-4)
204 (defface gnus-cite-5 '((((class color)
213 :group 'gnus-cite)
215 (put 'gnus-cite-face-5 'face-alias 'gnus-cite-5)
217 (defface gnus-cite-6 '((((class color)
226 :group 'gnus-cite)
228 (put 'gnus-cite-face-6 'face-alias 'gnus-cite-6)
230 (defface gnus-cite-7 '((((class color)
239 :group 'gnus-cite)
241 (put 'gnus-cite-face-7 'face-alias 'gnus-cite-7)
243 (defface gnus-cite-8 '((((class color)
252 :group 'gnus-cite)
254 (put 'gnus-cite-face-8 'face-alias 'gnus-cite-8)
256 (defface gnus-cite-9 '((((class color)
265 :group 'gnus-cite)
267 (put 'gnus-cite-face-9 'face-alias 'gnus-cite-9)
269 (defface gnus-cite-10 '((((class color)
278 :group 'gnus-cite)
280 (put 'gnus-cite-face-10 'face-alias 'gnus-cite-10)
282 (defface gnus-cite-11 '((((class color)
291 :group 'gnus-cite)
293 (put 'gnus-cite-face-11 'face-alias 'gnus-cite-11)
295 (defcustom gnus-cite-face-list
296 '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
297 gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11)
301 Gnus will try to give each citation from each article its own face.
303 :group 'gnus-cite
306 (defcustom gnus-cite-hide-percentage 50
307 "Only hide excess citation if above this percentage of the body."
308 :group 'gnus-cite
311 (defcustom gnus-cite-hide-absolute 10
312 "Only hide excess citation if above this number of lines in the body."
313 :group 'gnus-cite
316 (defcustom gnus-cite-blank-line-after-header t
317 "If non-nil, put a blank line between the citation header and the button."
318 :group 'gnus-cite
322 ;; gnus-cite-face-list.
323 (defcustom gnus-article-boring-faces (cons 'gnus-signature gnus-cite-face-list)
325 If an article has more pages below the one you are looking at, but
329 :group 'gnus-article-hiding)
333 (defvar gnus-cite-article nil)
334 (defvar gnus-cite-overlay-list nil)
336 (defvar gnus-cite-prefix-alist nil)
337 ;; Alist of citation prefixes.
340 (defvar gnus-cite-attribution-alist nil)
343 ;; The cdr is the prefix for the citation started by that line.
345 (defvar gnus-cite-loose-prefix-alist nil)
346 ;; Alist of citation prefixes that have no matching attribution.
349 (defvar gnus-cite-loose-attribution-alist nil)
350 ;; Alist of attribution lines that have no matching citation.
354 ;; PREFIX: Is the citation prefix of the attribution line(s), and
357 (defvar gnus-cited-opened-text-button-line-format-alist
362 (defvar gnus-cited-opened-text-button-line-format-spec nil)
363 (defvar gnus-cited-closed-text-button-line-format-alist
364 gnus-cited-opened-text-button-line-format-alist)
365 (defvar gnus-cited-closed-text-button-line-format-spec nil)
370 (defun gnus-article-highlight-citation (&optional force)
372 Each citation in the article will be highlighted with a different face.
373 The faces are taken from `gnus-cite-face-list'.
375 corresponding citation merged with the face `gnus-cite-attribution'.
377 Text is considered cited if at least `gnus-cite-minimum-match-count'
380 Lines matching `gnus-cite-attribution-suffix' and perhaps
381 `gnus-cite-attribution-prefix' are considered attribution lines."
384 (set-buffer gnus-article-buffer)
385 (gnus-cite-parse-maybe force)
387 (alist gnus-cite-prefix-alist)
388 (faces gnus-cite-face-list)
391 ;; Loop through citation prefixes.
398 faces (or (cdr faces) gnus-cite-face-list)
403 (and (not (assq number gnus-cite-attribution-alist))
404 (not (assq number gnus-cite-loose-attribution-alist))
405 (gnus-cite-add-face number prefix face))))
407 (setq alist gnus-cite-attribution-alist)
413 skip (gnus-cite-find-prefix number)
418 (when (re-search-forward gnus-cite-attribution-suffix
419 (gnus-point-at-eol)
421 (gnus-article-add-button (match-beginning 1) (match-end 1)
422 'gnus-cite-toggle prefix))
424 (gnus-cite-add-face number skip face)
425 (gnus-cite-add-face number skip gnus-cite-attribution-face))
427 (setq alist gnus-cite-loose-attribution-alist)
432 skip (gnus-cite-find-prefix number))
433 (gnus-cite-add-face number skip gnus-cite-attribution-face)))))
435 (defun gnus-dissect-cited-text ()
436 "Dissect the article buffer looking for cited text."
438 (set-buffer gnus-article-buffer)
439 (gnus-cite-parse-maybe nil t)
440 (let ((alist gnus-cite-prefix-alist)
442 ;; Loop through citation prefixes.
458 (article-goto-body)
462 (gnus-article-search-signature)
494 (defun gnus-article-fill-cited-article (&optional force width)
495 "Do word wrapping in the current article.
499 (set-buffer gnus-article-buffer)
502 (marks (gnus-dissect-cited-text))
521 (setq gnus-cite-prefix-alist nil
522 gnus-cite-attribution-alist nil
523 gnus-cite-loose-prefix-alist nil
524 gnus-cite-loose-attribution-alist nil
525 gnus-cite-article nil)))))
527 (defun gnus-article-hide-citation (&optional arg force)
529 See the documentation for `gnus-article-highlight-citation'.
531 always hide."
532 (interactive (append (gnus-article-hidden-arg) (list 'force)))
533 (gnus-set-format 'cited-opened-text-button t)
534 (gnus-set-format 'cited-closed-text-button t)
536 (set-buffer gnus-article-buffer)
540 (props (nconc (list 'article-type 'cite)
541 gnus-hidden-properties))
546 'gnus-callback
547 'gnus-article-toggle-cited-text))
550 (gnus-article-toggle-cited-text
551 (get-text-property point 'gnus-data) arg)
555 (setq marks (gnus-dissect-cited-text))
568 (when (and beg end gnus-cited-lines-visible)
570 (forward-line (if (consp gnus-cited-lines-visible)
571 (car gnus-cited-lines-visible)
572 gnus-cited-lines-visible))
576 (when (consp gnus-cited-lines-visible)
578 (forward-line (- (cdr gnus-cited-lines-visible)))
583 (gnus-add-wash-type 'cite)
588 (gnus-add-text-properties-when 'article-type nil beg end props)
590 (when (and gnus-cite-blank-line-after-header
596 (gnus-article-add-button
598 (progn (eval gnus-cited-closed-text-button-line-format-spec)
600 `gnus-article-toggle-cited-text
603 'article-type 'annotation)
606 (defun gnus-article-toggle-cited-text (args &optional arg)
608 ARG can be nil or a number. Positive means hide, negative
615 (text-property-any beg (1- end) 'article-type 'cite))
626 (gnus-remove-text-properties-when
627 'article-type 'cite beg end
628 (cons 'article-type (cons 'cite
629 gnus-hidden-properties))))
630 (gnus-add-wash-type 'cite)
631 (gnus-add-text-properties-when
632 'article-type nil beg end
633 (cons 'article-type (cons 'cite
634 gnus-hidden-properties))))
635 (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
636 (gnus-set-mode-line 'article))
639 (gnus-delete-line)
643 (gnus-article-add-button
647 gnus-cited-opened-text-button-line-format-spec
648 gnus-cited-closed-text-button-line-format-spec))
650 `gnus-article-toggle-cited-text
653 'article-type 'annotation)))))
655 (defun gnus-article-hide-citation-maybe (&optional arg force)
658 always hide.
659 This will do nothing unless at least `gnus-cite-hide-percentage'
660 percent and at least `gnus-cite-hide-absolute' lines of the body is
663 See also the documentation for `gnus-article-highlight-citation'."
664 (interactive (append (gnus-article-hidden-arg) '(force)))
665 (with-current-buffer gnus-article-buffer
666 (gnus-delete-wash-type 'cite)
667 (unless (gnus-article-check-hidden-text 'cite arg)
669 (gnus-cite-parse-maybe force)
670 (article-goto-body)
672 (atts gnus-cite-attribution-alist)
678 (gnus-article-search-signature)
682 gnus-cite-prefix-alist))))
685 (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
686 (> hidden gnus-cite-hide-absolute)))
687 (gnus-add-wash-type 'cite)
688 (setq atts gnus-cite-attribution-alist)
690 (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
697 (unless (assq hidden gnus-cite-attribution-alist)
698 (gnus-add-text-properties
700 (nconc (list 'article-type 'cite)
701 gnus-hidden-properties)))))))))
702 (gnus-set-mode-line 'article)))
704 (defun gnus-article-hide-citation-in-followups ()
708 (set-buffer gnus-article-buffer)
709 (let ((article (cdr gnus-article-current)))
711 (set-buffer gnus-summary-buffer)
712 (gnus-article-displayed-root-p article))
713 (gnus-article-hide-citation)))))
717 (defun gnus-cite-parse-maybe (&optional force no-overlay)
719 (gnus-cite-localize)
721 (setq gnus-cite-prefix-alist nil
722 gnus-cite-attribution-alist nil
723 gnus-cite-loose-prefix-alist nil
724 gnus-cite-loose-attribution-alist nil)
726 (gnus-cite-delete-overlays))
728 (if (and gnus-cite-parse-max-size
729 (> (buffer-size) gnus-cite-parse-max-size))
731 (setq gnus-cite-article (cons (car gnus-article-current)
732 (cdr gnus-article-current)))
733 (gnus-cite-parse-wrapper)))
735 (defun gnus-cite-delete-overlays ()
736 (dolist (overlay gnus-cite-overlay-list)
738 (when (or (not (gnus-overlay-end overlay))
739 (and (>= (gnus-overlay-end overlay) (point-min))
740 (<= (gnus-overlay-end overlay) (point-max))))
741 (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
743 (gnus-delete-overlay overlay))))))
745 (defun gnus-cite-parse-wrapper ()
746 ;; Wrap chopped gnus-cite-parse.
747 (article-goto-body)
750 (gnus-cite-parse-attributions))
752 (gnus-cite-parse))
754 (gnus-cite-connect-attributions))))
756 (defun gnus-cite-parse ()
757 ;; Parse and connect citation prefixes and attribution lines.
759 ;; Parse current buffer searching for citation prefixes.
764 (gnus-article-search-signature)
773 end (gnus-point-at-bol 2)
777 (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
778 (looking-at gnus-supercite-regexp))
783 (when (> end (+ begin gnus-cite-max-prefix))
784 (setq end (+ begin gnus-cite-max-prefix)))
786 (when (and gnus-cite-ignore-quoted-from
796 (gnus-set-text-properties 0 (length prefix) nil prefix)
806 (when (re-search-forward gnus-cite-unsightly-citation-regexp max t)
815 ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
816 ;; line that appears at least `gnus-cite-minimum-match-count'
829 ((< (length numbers) gnus-cite-minimum-match-count)
834 (push entry gnus-cite-prefix-alist))
837 gnus-cite-prefix-alist)
845 (gnus-set-difference (cdr current) numbers)))))))))
847 (defun gnus-cite-parse-attributions ()
850 (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
854 (prefix (gnus-cite-find-prefix wrote))
858 (when (looking-at gnus-supercite-secondary-regexp)
863 (and (re-search-backward gnus-cite-attribution-prefix
868 (not (re-search-forward gnus-cite-attribution-suffix
881 gnus-cite-loose-attribution-alist)
884 (defun gnus-cite-connect-attributions ()
888 (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
892 (gnus-cite-match-attributions 'small nil
899 (gnus-cite-match-attributions 'small t
906 (gnus-cite-match-attributions 'small nil
913 (gnus-cite-match-attributions 'small-if-unique t
917 (gnus-cite-match-attributions 'small nil
921 (let ((alist gnus-cite-loose-prefix-alist)
926 (when (< (length (cdr entry)) gnus-cite-minimum-match-count)
927 (setq gnus-cite-prefix-alist
928 (delq entry gnus-cite-prefix-alist)
929 gnus-cite-loose-prefix-alist
930 (delq entry gnus-cite-loose-prefix-alist)))))
932 (gnus-cite-match-attributions 'first t nil)
934 (gnus-cite-match-attributions 'first nil nil))
936 (defun gnus-cite-match-attributions (sort after fun)
939 ;; If SORT is `small', the citation with the shortest prefix will be
956 (let ((atts gnus-cite-loose-attribution-alist)
969 (t (< (length (gnus-cite-find-loose prefix)) 2)))
973 (let ((cites gnus-cite-loose-prefix-alist)
990 (setq gnus-cite-loose-attribution-alist
991 (delq att gnus-cite-loose-attribution-alist))
992 (push (cons wrote (car best)) gnus-cite-attribution-alist)
994 (push (cons in (car best)) gnus-cite-attribution-alist))
995 (when (memq best gnus-cite-loose-prefix-alist)
996 (let ((loop gnus-cite-prefix-alist)
999 (setq gnus-cite-loose-prefix-alist
1000 (delq best gnus-cite-loose-prefix-alist))
1006 (setcdr current (gnus-set-difference (cdr current) numbers))
1008 (setq gnus-cite-loose-prefix-alist
1009 (delq current gnus-cite-loose-prefix-alist)
1012 (defun gnus-cite-find-loose (prefix)
1014 (let* ((atts gnus-cite-loose-attribution-alist)
1020 (when (string-equal (gnus-cite-find-prefix line) prefix)
1024 (defun gnus-cite-add-face (number prefix face)
1038 (push (setq overlay (gnus-make-overlay from to))
1039 gnus-cite-overlay-list)
1040 (gnus-overlay-put overlay 'evaporate t)
1041 (gnus-overlay-put overlay 'face face))))))
1043 (defun gnus-cite-toggle (prefix)
1045 (set-buffer gnus-article-buffer)
1046 (gnus-cite-parse-maybe nil t)
1048 (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
1060 gnus-hidden-properties))
1061 ((assq number gnus-cite-attribution-alist))
1063 (gnus-add-wash-type 'cite)
1064 (gnus-add-text-properties
1066 (nconc (list 'article-type 'cite)
1067 gnus-hidden-properties))))
1068 (let ((gnus-article-mime-handle-alist-1
1069 gnus-article-mime-handle-alist))
1070 (gnus-set-mode-line 'article))))))
1072 (defun gnus-cite-find-prefix (line)
1073 ;; Return citation prefix for LINE.
1074 (let ((alist gnus-cite-prefix-alist)
1084 (defun gnus-cite-localize ()
1085 "Make the citation variables local to the article buffer."
1086 (let ((vars '(gnus-cite-article
1087 gnus-cite-overlay-list gnus-cite-prefix-alist
1088 gnus-cite-attribution-alist gnus-cite-loose-prefix-alist
1089 gnus-cite-loose-attribution-alist)))
1093 (defun gnus-cited-line-p ()
1098 (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
1104 (gnus-ems-redefine)
1106 (provide 'gnus-cite)
1113 ;;; gnus-cite.el ends here