X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=657313b8555262869979c8f0b9e0f072ec02e5f9;hb=715b67ed5807f6a6e17f944f2317dd23bc9c8e8f;hp=aaf46a5f14ddba0bbbf90b4986c9d6cfe9d96d24;hpb=30d9f23f0291edcefeca1958befadb992d2982b5;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index aaf46a5..657313b 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.
@@ -21,10 +27,12 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (require 'gnus)
 (require 'gnus-art)
 (require 'gnus-range)
+(require 'message)	; for message-cite-prefix-regexp
 
 ;;; Customization:
 
@@ -42,10 +50,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 +81,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."
@@ -104,7 +106,7 @@ 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\\),\\|    > -----Original Message-----"
+  "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)
@@ -238,8 +240,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 +307,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 +440,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,19 +465,25 @@ 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))
-	    (inhibit-point-motion-hooks t)
-	    (props (nconc (list 'article-type 'cite)
-			  gnus-hidden-properties))
-	    beg end start)
+    (let ((buffer-read-only nil)
+	  marks
+	  (inhibit-point-motion-hooks t)
+	  (props (nconc (list 'article-type 'cite)
+			gnus-hidden-properties))
+	  (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)
@@ -505,7 +515,7 @@ always hide."
 	    ;; 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)
+	    (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"))
@@ -520,39 +530,50 @@ always hide."
 		(list (cons beg end) start))
 	       (point))
 	     'article-type 'annotation)
-	    (set-marker beg (point)))))))))
+	    (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 +681,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 mc-flag)
     ;; 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))
@@ -905,7 +929,12 @@ See also the documentation for `gnus-article-highlight-citation'."
 	  from to overlay)
       (goto-char (point-min))
       (when (zerop (forward-line (1- number)))
-	(forward-char (length prefix))
+	(static-if (or (featurep 'xemacs)
+		       (and (eq emacs-major-version 20)
+			    (>= emacs-minor-version 3))
+		       (>= emacs-major-version 21))
+	    (forward-char (length prefix))
+	  (move-to-column (string-width prefix)))
 	(skip-chars-forward " \t")
 	(setq from (point))
 	(end-of-line 1)
@@ -964,4 +993,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