From: teranisi <teranisi>
Date: Thu, 26 Oct 2000 09:31:37 +0000 (+0000)
Subject: * wl-highlight.el (wl-highlight-message):
X-Git-Tag: wl-2_4-root~77
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=98e678ff0ed8526a2c036da3dab39cb08e7a05ba;p=elisp%2Fwanderlust.git

* wl-highlight.el (wl-highlight-message):
Use `std11-field-end' to detect end point of the header field.
Refer `wl-highlight-max-header-size'.

* wl-vars.el (wl-highlight-max-header-size): New variable.
---

diff --git a/wl/ChangeLog b/wl/ChangeLog
index a8c0220..72ccab0 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,5 +1,11 @@
 2000-10-26  Yuuichi Teranishi  <teranisi@gohome.org>
 
+	* wl-highlight.el (wl-highlight-message):
+	Use `std11-field-end' to detect end point of the header field.
+	Refer `wl-highlight-max-header-size'.
+
+	* wl-vars.el (wl-highlight-max-header-size): New variable.
+
 	* wl-highlight.el (wl-highlight-headers): Added argument `for-draft'.
 
 	* wl-draft.el (wl-draft-yank-from-mail-reply-buffer):
diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el
index f8a5b9e..90ebebc 100644
--- a/wl/wl-highlight.el
+++ b/wl/wl-highlight.el
@@ -1137,116 +1137,114 @@ part of the message (this is because signatures are often incorrectly
 interpreted as cited text.)"
   (if (< end start)
       (let ((s start)) (setq start end end s)))
-  (let* ((too-big (and wl-highlight-max-message-size
-		       (> (- end start)
-			  wl-highlight-max-message-size)))
-	 (real-end end)
-	 current  beg
-	 e p hend)
-    (save-excursion
-      (save-restriction
-	(widen)
-	;; take off signature
-	(if (and hack-sig (not too-big))
-	    (setq end (funcall wl-highlight-signature-search-func
-			       (- end wl-max-signature-size) end)))
-	(if hack-sig
-	    (put-text-property end (point-max)
-			       'face 'wl-highlight-message-signature))
-	(narrow-to-region start end)
-
+  (let ((too-big (and wl-highlight-max-message-size
+		      (> (- end start)
+			 wl-highlight-max-message-size)))
+	(real-end end)
+	current  beg
+	e p hend)
+    (if too-big
+	nil    
+      (save-excursion
 	(save-restriction
-	  ;; narrow down to just the headers...
-	  (goto-char start)
-	  ;; If this search fails then the narrowing performed above
-	  ;; is sufficient
-	  (if (re-search-forward (format
-				  "^$\\|%s"
-				  (regexp-quote mail-header-separator)) nil t)
-	      (narrow-to-region (point-min) (point)))
-	  (goto-char start)
-	  (while (and (not body-only)
-		      (not (eobp)))
-	    (cond
-	     ((looking-at "^\\([^ \t\n:]+[ \t]*:\\) *\\(.*\\(\n[ \t].*\\)*\n\\)")
-	      (setq hend (match-end 0))
-	      (put-text-property (match-beginning 1) (match-end 1)
-				 'face 'wl-highlight-message-headers)
-	      (setq p (match-end 1))
-	      (cond
-	       ((catch 'match
-		  (let ((regexp-alist wl-highlight-message-header-alist))
-		    (while regexp-alist
-		      (when (save-match-data
-			      (looking-at (caar regexp-alist)))
-			(put-text-property
-			 (match-beginning 2) (match-end 2)
-			 'face
-			 (cdar regexp-alist))
-			(throw 'match t))
-		      (setq regexp-alist (cdr regexp-alist)))
-		    (throw 'match nil))))
-	       (t
-		(put-text-property
-		 (match-beginning 2) (match-end 2)
-		 'face 'wl-highlight-message-header-contents)))
-	      (goto-char hend))
-	     ((looking-at mail-header-separator)
-	      (put-text-property (match-beginning 0) (match-end 0)
-				 'face 'wl-highlight-header-separator-face)
-	      (goto-char (match-end 0)))
-	     ;; ignore non-header field name lines
-	     (t (forward-line 1)))))
-	;; now do the body, unless it's too big....
-	(if too-big
-	    nil
+	  (widen)
+	  ;; take off signature
+	  (if (and hack-sig (not too-big))
+	      (setq end (funcall wl-highlight-signature-search-func
+				 (- end wl-max-signature-size) end)))
+	  (if hack-sig
+	      (put-text-property end (point-max)
+				 'face 'wl-highlight-message-signature))
+	  (narrow-to-region start end)
+	  (save-restriction
+	    ;; narrow down to just the headers...
+	    (goto-char start)
+	    ;; If this search fails then the narrowing performed above
+	    ;; is sufficient
+	    (if (re-search-forward (format
+				    "^$\\|%s"
+				    (regexp-quote mail-header-separator)) 
+				   nil t)
+		(narrow-to-region (point-min) (point)))
+	    ;; highlight only when header is not too-big.
+	    (when (or (null wl-highlight-max-header-size)
+		      (< (point) wl-highlight-max-header-size))
+	      (goto-char start)
+	      (while (and (not body-only)
+			  (not (eobp)))
+		(cond
+		 ((looking-at "^[^ \t\n:]+[ \t]*:")
+		  (put-text-property (match-beginning 0) (match-end 0)
+				     'face 'wl-highlight-message-headers)
+		  (setq p (match-end 0))
+		  (setq hend (save-excursion (std11-field-end end)))
+		  (cond
+		   ((catch 'match
+		      (let ((regexp-alist wl-highlight-message-header-alist))
+			(while regexp-alist
+			  (when (save-match-data
+				  (looking-at (caar regexp-alist)))
+			    (put-text-property p hend 'face
+					       (cdar regexp-alist))
+			    (throw 'match t))
+			  (setq regexp-alist (cdr regexp-alist)))
+			(throw 'match nil))))
+		   (t
+		    (put-text-property
+		     p hend 'face 'wl-highlight-message-header-contents)))
+		  (goto-char hend))
+		 ((looking-at mail-header-separator)
+		  (put-text-property (match-beginning 0) (match-end 0)
+				     'face 'wl-highlight-header-separator-face)
+		  (goto-char (match-end 0)))
+		 ;; ignore non-header field name lines
+		 (t (forward-line 1))))))
 	  (let (prefix prefix-face-alist pair end)
-	  (while (not (eobp))
-	    (cond
-	     ((null wl-highlight-force-citation-header-regexp)
-	      nil)
-	     ((looking-at wl-highlight-force-citation-header-regexp)
-	      (setq current 'wl-highlight-message-citation-header)
-	      (setq end (match-end 0)))
-	     ((null wl-highlight-citation-prefix-regexp)
-	      nil)
-	     ((looking-at wl-highlight-citation-prefix-regexp)
-	      (setq prefix (buffer-substring (point)
-					     (match-end 0)))
-	      (setq pair (assoc prefix prefix-face-alist))
-	      (unless pair
-		(setq prefix-face-alist
-		      (append prefix-face-alist
-			      (list
-			       (setq pair
-				     (cons
-				      prefix
-				      (nth
-				       (% (length prefix-face-alist)
-					  (length
-					   wl-highlight-citation-face-list))
-				       wl-highlight-citation-face-list)))))))
-	      (unless wl-highlight-highlight-citation-too
-		(goto-char (match-end 0)))
-	      (setq current (cdr pair)))
-	     ((null wl-highlight-citation-header-regexp)
-	      nil)
-	     ((looking-at wl-highlight-citation-header-regexp)
-	      (setq current 'wl-highlight-message-citation-header)
-	      (setq end (match-end 0)))
-	     (t (setq current nil)))
-	    (cond (current
-		   (setq p (point))
-		   (forward-line 1) ; this is to put the \n in the face too
-		   (let ();(inhibit-read-only t))
-		     (put-text-property p (or end (point))
-					'face current)
-		     (setq end nil))
-		   (forward-char -1)))
-	    (forward-line 1)))
+	    (while (not (eobp))
+	      (cond
+	       ((null wl-highlight-force-citation-header-regexp)
+		nil)
+	       ((looking-at wl-highlight-force-citation-header-regexp)
+		(setq current 'wl-highlight-message-citation-header)
+		(setq end (match-end 0)))
+	       ((null wl-highlight-citation-prefix-regexp)
+		nil)
+	       ((looking-at wl-highlight-citation-prefix-regexp)
+		(setq prefix (buffer-substring (point)
+					       (match-end 0)))
+		(setq pair (assoc prefix prefix-face-alist))
+		(unless pair
+		  (setq prefix-face-alist
+			(append prefix-face-alist
+				(list
+				 (setq pair
+				       (cons
+					prefix
+					(nth
+					 (% (length prefix-face-alist)
+					    (length
+					     wl-highlight-citation-face-list))
+					 wl-highlight-citation-face-list)))))))
+		(unless wl-highlight-highlight-citation-too
+		  (goto-char (match-end 0)))
+		(setq current (cdr pair)))
+	       ((null wl-highlight-citation-header-regexp)
+		nil)
+	       ((looking-at wl-highlight-citation-header-regexp)
+		(setq current 'wl-highlight-message-citation-header)
+		(setq end (match-end 0)))
+	       (t (setq current nil)))
+	      (cond (current
+		     (setq p (point))
+		     (forward-line 1) ; this is to put the \n in the face too
+		     (let ();(inhibit-read-only t))
+		       (put-text-property p (or end (point))
+					  'face current)
+		       (setq end nil))
+		     (forward-char -1)))
+	      (forward-line 1)))
 	  (run-hooks 'wl-highlight-message-hook))))))
 
-
 ;; highlight-mouse-line for folder mode
 
 (defun wl-highlight-folder-mouse-line ()
diff --git a/wl/wl-vars.el b/wl/wl-vars.el
index 0e7caf9..4b56702 100644
--- a/wl/wl-vars.el
+++ b/wl/wl-vars.el
@@ -2002,6 +2002,12 @@ the `wl-highlight-message-headers' face."
   :type 'regexp
   :group 'wl-highlight)
 
+(defcustom wl-highlight-max-header-size nil
+  "*If the message header is larger than this many chars, don't highlight it.
+If this is nil, all headers will be highlighted."
+  :type 'integer
+  :group 'wl-highlight)  
+
 (defcustom wl-highlight-max-message-size 10000
   "*If the message body is larger than this many chars, don't highlight it.
 This is to prevent us from wasting time trying to fontify things like