X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=73c4befc8a7b32930bfead78c724d9a68772a301;hb=55f610143f1f63a6cc448649d02a51a0b99c04f1;hp=6c70d44e72d1968fc231aff1a83158e015bf9d81;hpb=90b0036db876985a484966d646b71cc412f3dba6;p=gnus diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 6c70d44e7..73c4befc8 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,7 +1,13 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*- -;; Author: Per Abhiddenware; you can redistribute it and/or modify +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. + +;; Author: Per Abhiddenware + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. @@ -25,6 +31,7 @@ (require 'gnus) (require 'gnus-art) (require 'gnus-range) +(require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -42,10 +49,10 @@ article has citations." :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." @@ -73,19 +80,13 @@ Set it to nil to parse all articles." :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." @@ -238,8 +239,8 @@ It is merged with the face for the cited text belonging to the attribution." (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, @@ -305,7 +306,7 @@ Attribution lines are highlighted with the same face as the 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." @@ -438,7 +439,9 @@ If WIDTH (the numerical prefix), use that text width when filling." (narrow-to-region (caar marks) (caadr marks)) (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) + (fill-prefix + (if (string= (cdar marks) "") "" + (concat (cdar marks) " ")))) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) @@ -461,57 +464,63 @@ always hide." (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) + marks (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) - beg end start) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) + (while marks + (setq beg nil + end nil) + (while (and marks (string= (cdar marks) "")) + (setq marks (cdr marks))) + (when marks + (setq beg (caar marks))) + (while (and marks (not (string= (cdar marks) ""))) + (setq marks (cdr marks))) + (when marks (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (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)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (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)) + (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. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn + (when (and beg end) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) + (gnus-add-text-properties-when 'article-type nil beg end props) + (goto-char beg) + (unless (save-excursion (search-backward "\n\n" nil t)) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -519,40 +528,51 @@ always hide." `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) + 'article-type 'annotation) + (set-marker beg (point)))))))) -(defun gnus-article-toggle-cited-text (args) - "Toggle hiding the text in REGION." +(defun gnus-article-toggle-cited-text (args &optional arg) + "Toggle hiding the text in REGION. +ARG can be nil or a number. Positive means hide, negative +means show, nil means toggle." (let* ((region (car args)) + (beg (car region)) + (end (cdr region)) (start (cadr args)) (hidden - (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties))) + (text-property-any beg (1- end) 'article-type 'cite)) (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) - (save-excursion - (goto-char start) - (gnus-delete-line) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval - (if hidden - gnus-cited-opened-text-button-line-format-spec - gnus-cited-closed-text-button-line-format-spec)) - (point)) - `gnus-article-toggle-cited-text - args) - (point)) - 'article-type 'annotation)))) + (when (or (null arg) + (zerop arg) + (and (> arg 0) (not hidden)) + (and (< arg 0) hidden)) + (if hidden + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (save-excursion + (goto-char start) + (gnus-delete-line) + (put-text-property + (point) + (progn + (gnus-article-add-button + (point) + (progn (eval + (if hidden + gnus-cited-opened-text-button-line-format-spec + gnus-cited-closed-text-button-line-format-spec)) + (point)) + `gnus-article-toggle-cited-text + args) + (point)) + 'article-type 'annotation))))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. @@ -660,23 +680,26 @@ See also the documentation for `gnus-article-highlight-citation'." (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)) @@ -964,4 +987,8 @@ See also the documentation for `gnus-article-highlight-citation'." (provide 'gnus-cite) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-cite.el ends here