X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=a5ab85476e32fb29b9ee0cb5e2db09381a881e85;hb=deefcadcd864c43eb6dc3191339b0d5132a40cd2;hp=5710910a064bd393c0ef90274f2f42ddb5181143;hpb=911ab3779277309b78f940f72a4ca308bddc6ec9;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index 5710910..a5ab854 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 Free Software Foundation, Inc.
 
-;; Author: Per Abhiddenware; you can redistribute it and/or modify
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;;        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."
@@ -58,10 +65,13 @@ article has citations."
   :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.
@@ -70,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."
@@ -101,13 +105,13 @@ The first regexp group should match the Supercite attribution."
   :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
@@ -235,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,
@@ -255,6 +259,11 @@ This should make it easier to see who wrote what."
   :group 'gnus-cite
   :type 'integer)
 
+(defcustom gnus-cite-blank-line-after-header t
+  "If non-nil, put a blank line between the citation header and the button."
+  :group 'gnus-cite
+  :type 'boolean)
+
 ;;; Internal Variables:
 
 (defvar gnus-cite-article nil)
@@ -284,6 +293,7 @@ This should make it easier to see who wrote what."
 (defvar gnus-cited-opened-text-button-line-format-alist
   `((?b (marker-position beg) ?d)
     (?e (marker-position end) ?d)
+    (?n (count-lines beg end) ?d)
     (?l (- end beg) ?d)))
 (defvar gnus-cited-opened-text-button-line-format-spec nil)
 (defvar gnus-cited-closed-text-button-line-format-alist
@@ -301,7 +311,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."
@@ -339,7 +349,8 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
 	      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)
@@ -361,7 +372,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
   "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.
@@ -380,8 +391,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
 	  (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))
@@ -431,11 +441,13 @@ If WIDTH (the numerical prefix), use that text width when filling."
 	  (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)) " *"))
-		(fill-prefix (cdar marks)))
+		(fill-prefix
+		 (if (string= (cdar marks) "") ""
+		   (concat (cdar marks) " ")))
+		use-hard-newlines)
 	    (fill-region (point-min) (point-max)))
 	  (set-marker (caar marks) nil)
 	  (setq marks (cdr marks)))
@@ -458,49 +470,65 @@ 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 gnus-cited-lines-visible)
-	    (if (>= (point) end)
-		(setq beg nil)
-	      (setq beg (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
+	    ;; 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)
+	      (gnus-add-wash-type 'cite)
+	      ;; 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)
+	      (when (and gnus-cite-blank-line-after-header
+			 (not (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)
@@ -508,40 +536,57 @@ 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
+	  (progn
+	    ;; Can't remove 'cite from g-a-wash-types here because
+	    ;; multiple citations may be hidden -jas
+	    (gnus-remove-text-properties-when
+	     'article-type 'cite beg end
+	     (cons 'article-type (cons 'cite
+				       gnus-hidden-properties))))
+	(gnus-add-wash-type 'cite)
+	(gnus-add-text-properties-when
+	 'article-type nil beg end
+	 (cons 'article-type (cons 'cite
+				   gnus-hidden-properties))))
+      (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
+	(gnus-set-mode-line 'article))
+      (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.
@@ -557,8 +602,7 @@ See also the documentation for `gnus-article-highlight-citation'."
     (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)
@@ -582,7 +626,8 @@ See also the documentation for `gnus-article-highlight-citation'."
 	    (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))
@@ -602,45 +647,43 @@ See also the documentation for `gnus-article-highlight-citation'."
 
 ;;; 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))
+      (ignore-errors
+	(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.
@@ -652,23 +695,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))
@@ -895,8 +941,8 @@ See also the documentation for `gnus-article-highlight-citation'."
   (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))
@@ -911,7 +957,7 @@ See also the documentation for `gnus-article-highlight-citation'."
 (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)
@@ -919,16 +965,23 @@ See also the documentation for `gnus-article-highlight-citation'."
       (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)
+	       ;; Can't remove 'cite from g-a-wash-types here because
+	       ;; multiple citations may be hidden -jas
 	       (remove-text-properties (point) (progn (forward-line 1) (point))
 				       gnus-hidden-properties))
 	      ((assq number gnus-cite-attribution-alist))
 	      (t
+	       (gnus-add-wash-type 'cite)
 	       (gnus-add-text-properties
 		(point) (progn (forward-line 1) (point))
 		(nconc (list 'article-type 'cite)
-		       gnus-hidden-properties))))))))
+		       gnus-hidden-properties))))
+	(let ((gnus-article-mime-handle-alist-1
+	       gnus-article-mime-handle-alist))
+	  (gnus-set-mode-line 'article))))))
 
 (defun gnus-cite-find-prefix (line)
   ;; Return citation prefix for LINE.
@@ -955,4 +1008,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