X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=b432a6a94419677d9cca81a3885d20d75774281c;hb=c2738fdc4e616fb55973a7e285432f60af6c1c57;hp=bbb0e1fe10781b9cb5188ad14c272fd876e9c850;hpb=0fbd8fa3e611a5f03687ff7e11f98083d67bc1ce;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el
index bbb0e1f..b432a6a 100644
--- a/wl/wl-highlight.el
+++ b/wl/wl-highlight.el
@@ -1,6 +1,7 @@
 ;;; wl-highlight.el --- Hilight modules for Wanderlust.
 
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;;  Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
@@ -42,12 +43,6 @@
 	 (require 'wl-e21))
 	(t
 	 (require 'wl-mule)))
-  (defun-maybe extent-begin-glyph (a))
-  (defun-maybe delete-extent (a))
-  (defun-maybe make-extent (a b))
-  (defun-maybe set-extent-begin-glyph (a b))
-  (defun-maybe set-extent-end-glyph (a b))
-  (defun-maybe extent-at (a b c d e))
   (defun-maybe wl-dnd-set-drop-target (a b))
   (defun-maybe wl-dnd-set-drag-starter (a b)))
 
@@ -255,7 +250,7 @@
   :group 'wl-summary-faces
   :group 'wl-faces)
 
-(wl-defface wl-highlight-summary-deleted-face
+(wl-defface wl-highlight-summary-disposed-face
   '(
     (((type tty)
       (background dark))
@@ -266,10 +261,55 @@
     (((class color)
       (background light))
      (:foreground "DarkKhaki")))
+  "Face used for displaying messages mark as disposed."
+  :group 'wl-summary-faces
+  :group 'wl-faces)
+
+(wl-defface wl-highlight-summary-deleted-face
+  '(
+    (((type tty)
+      (background dark))
+     (:foreground "blue"))
+    (((class color)
+      (background dark))
+     (:foreground "SteelBlue"))
+    (((class color)
+      (background light))
+     (:foreground "RoyalBlue4")))
   "Face used for displaying messages mark as deleted."
   :group 'wl-summary-faces
   :group 'wl-faces)
 
+(wl-defface wl-highlight-summary-prefetch-face
+  '(
+    (((type tty)
+      (background dark))
+     (:foreground "Green"))
+    (((class color)
+      (background dark))
+     (:foreground "DeepSkyBlue"))
+    (((class color)
+      (background light))
+     (:foreground "brown")))
+  "Face used for displaying messages mark as deleted."
+  :group 'wl-summary-faces
+  :group 'wl-faces)
+
+(wl-defface wl-highlight-summary-resend-face
+  '(
+    (((type tty)
+      (background dark))
+     (:foreground "Yellow"))
+    (((class color)
+      (background dark))
+     (:foreground "orange3"))
+    (((class color)
+      (background light))
+     (:foreground "orange3")))
+  "Face used for displaying messages mark as resend."
+  :group 'wl-summary-faces
+  :group 'wl-faces)
+
 (wl-defface wl-highlight-summary-refiled-face
   '(
     (((type tty)
@@ -300,6 +340,21 @@
   :group 'wl-summary-faces
   :group 'wl-faces)
 
+;; answered 
+(wl-defface wl-highlight-summary-answered-face
+  '((((type tty)
+      (background dark))
+     (:foreground "yellow"))
+    (((class color)
+      (background dark))
+     (:foreground "khaki"))
+    (((class color)
+      (background light))
+     (:foreground "khaki4")))
+  "Face used for displaying answered messages."
+  :group 'wl-summary-faces
+  :group 'wl-faces)  
+
 ;; obsolete.
 (wl-defface wl-highlight-summary-temp-face
   '(
@@ -566,14 +621,14 @@
   "Face used for displaying demo."
   :group 'wl-faces)
 
-(wl-defface wl-highlight-refile-destination-face
+(wl-defface wl-highlight-action-argument-face
   '((((class color)
       (background dark))
      (:foreground "pink"))
     (((class color)
       (background light))
      (:foreground "red")))
-  "Face used for displaying refile destination."
+  "Face used for displaying action argument."
   :group 'wl-summary-faces
   :group 'wl-faces)
 
@@ -697,15 +752,6 @@
 (defvar wl-highlight-folder-closed-regexp " *\\(\\[\\+\\]\\)")
 (defvar wl-highlight-folder-leaf-regexp "[ ]*\\([-%\\+]\\)\\(.*\\):.*$")
 
-(defvar wl-highlight-summary-unread-regexp " *[0-9]+[^0-9]\\(!\\|U\\)")
-(defvar wl-highlight-summary-important-regexp " *[0-9]+[^0-9]\\$")
-(defvar wl-highlight-summary-new-regexp " *[0-9]+[^0-9]N")
-(defvar wl-highlight-summary-deleted-regexp " *[0-9]+D")
-(defvar wl-highlight-summary-refiled-regexp " *[0-9]+o")
-(defvar wl-highlight-summary-copied-regexp " *[0-9]+O")
-(defvar wl-highlight-summary-target-regexp " *[0-9]+\\*")
-;;(defvar wl-highlight-summary-thread-top-regexp " *[0-9]+[^0-9][^0-9]../..\(.*\)..:.. \\[")
-
 (defvar wl-highlight-citation-face-list
   '(wl-highlight-message-cited-text-1
     wl-highlight-message-cited-text-2
@@ -774,135 +820,108 @@
 	      (put-text-property bol (match-end 0) 'face face)))
 	(put-text-property bol eol 'face text-face)))))
 
-(defun wl-highlight-summary-line-string (line mark temp-mark indent)
-  (let (fsymbol)
-    (cond ((and (string= temp-mark "+")
-		(member mark (list wl-summary-unread-cached-mark
-				   wl-summary-unread-uncached-mark
-				   wl-summary-new-mark)))
-	   (setq fsymbol 'wl-highlight-summary-high-unread-face))
-	  ((and (string= temp-mark "-")
-		(member mark (list wl-summary-unread-cached-mark
-				   wl-summary-unread-uncached-mark
-				   wl-summary-new-mark)))
-	   (setq fsymbol 'wl-highlight-summary-low-unread-face))
-	  ((string= temp-mark "o")
-	   (setq fsymbol 'wl-highlight-summary-refiled-face))
-	  ((string= temp-mark "O")
-	   (setq fsymbol 'wl-highlight-summary-copied-face))
-	  ((string= temp-mark "D")
-	   (setq fsymbol 'wl-highlight-summary-deleted-face))
-	  ((string= temp-mark "*")
-	   (setq fsymbol 'wl-highlight-summary-temp-face))
-	  ((string= mark wl-summary-new-mark)
-	   (setq fsymbol 'wl-highlight-summary-new-face))
-	  ((member mark (list wl-summary-unread-cached-mark
-			      wl-summary-unread-uncached-mark))
-	   (setq fsymbol 'wl-highlight-summary-unread-face))
-	  ((or (string= mark wl-summary-important-mark))
-	   (setq fsymbol 'wl-highlight-summary-important-face))
-	  ((string= temp-mark "-")
-	   (setq fsymbol 'wl-highlight-summary-low-read-face))
-	  ((string= temp-mark "+")
-	   (setq fsymbol 'wl-highlight-summary-high-read-face))
-	  (t (if (zerop (length indent))
-		 (setq fsymbol 'wl-highlight-summary-thread-top-face)
-	       (setq fsymbol 'wl-highlight-summary-normal-face))))
+(defsubst wl-highlight-summary-line-face-spec (flags temp-mark indent)
+  "Return a cons cell of (face . argument)."
+  (let (action)
+    (if (setq action (assoc temp-mark wl-summary-mark-action-list))
+	(cons (nth 5 action) (nth 2 action))
+      (cond
+       ((and (string= temp-mark wl-summary-score-over-mark)
+	     (or (memq 'new flags) (memq 'unread flags)))
+	'(wl-highlight-summary-high-unread-face))
+       ((and (string= temp-mark wl-summary-score-below-mark)
+	     (or (memq 'new flags) (memq 'unread flags)))
+	'(wl-highlight-summary-low-unread-face))
+       ((let ((priorities wl-summary-flag-priority-list)
+	      result)
+	  (while (and (null result) priorities)
+	    (when (memq (car priorities) flags)
+	      (setq result
+		    (case (car priorities)
+		      (new
+		       '(wl-highlight-summary-new-face))
+		      (important
+		       '(wl-highlight-summary-important-face))
+		      (answered
+		       '(wl-highlight-summary-answered-face))
+		      (unread
+		       '(wl-highlight-summary-unread-face)))))
+	    (setq priorities (cdr priorities)))
+	  result))
+       ((string= temp-mark wl-summary-score-below-mark)
+	'(wl-highlight-summary-low-read-face))
+       ((string= temp-mark wl-summary-score-over-mark)
+	'(wl-highlight-summary-high-read-face))
+       (t (if indent
+	      '(wl-highlight-summary-normal-face)
+	    '(wl-highlight-summary-thread-top-face)))))))
+
+(defun wl-highlight-summary-line-flag-folder (number beg end &optional string)
+  ;; help-echo for flag folder.
+  (let (flag-info)
+    (current-buffer)
+    (when (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
+	      'flag)
+      (setq flag-info
+	    (elmo-flag-folder-referrer wl-summary-buffer-elmo-folder
+				       number))
+      (if flag-info
+	  (put-text-property beg end 'help-echo
+			     (concat "The message exists in "
+				     (mapconcat
+				      (lambda (pair)
+					(concat (car pair) "/"
+						(number-to-string
+						 (cdr pair))))
+				      flag-info ","))
+			     string)))))
+
+(defun wl-highlight-summary-line-string (number line flags temp-mark indent)
+  (let ((fsymbol (car (wl-highlight-summary-line-face-spec
+		       flags
+		       temp-mark
+		       (> (length indent) 0)))))
     (put-text-property 0 (length line) 'face fsymbol line))
-  (if wl-use-highlight-mouse-line
-      (put-text-property 0 (length line) 'mouse-face 'highlight line)))
+  (when wl-use-highlight-mouse-line
+    (put-text-property 0 (length line) 'mouse-face 'highlight line))
+  (when wl-use-flag-folder-help-echo
+    (wl-highlight-summary-line-flag-folder number 0 (length line) line)))
 
-(defun wl-highlight-summary-current-line (&optional smark regexp temp-too)
+(defun wl-highlight-summary-current-line ()
   (interactive)
   (save-excursion
     (let ((inhibit-read-only t)
-	  (case-fold-search nil) temp-mark status-mark
+	  (case-fold-search nil)
 	  (deactivate-mark nil)
-	  (sregexp (concat
-		    "^"
-		    wl-summary-buffer-number-regexp
-		    "\\(.\\)\\(.\\)../..\(.*\)..:.. \\("
-		    wl-highlight-thread-indent-string-regexp
-		    "\\)[[<]"))
-	  fregexp fsymbol bol eol matched thread-top looked-at dest ds)
+	  (number (wl-summary-message-number))
+	  bol eol spec)
       (end-of-line)
       (setq eol (point))
       (beginning-of-line)
       (setq bol (point))
-      (if smark
-	  (setq status-mark smark)
-	(setq looked-at (looking-at sregexp))
-	(when looked-at
-	  (setq status-mark (buffer-substring (match-beginning 2)
-					      (match-end 2)))))
-      (when temp-too
-	(unless looked-at
-	  (setq looked-at (looking-at sregexp)))
-	(when looked-at
-	  (setq temp-mark (buffer-substring (match-beginning 1)
-					    (match-end 1)))
-	  (cond
-	   ((string= temp-mark "*")
-	    (setq fsymbol 'wl-highlight-summary-temp-face))
-	   ((string= temp-mark "D")
-	    (setq fsymbol 'wl-highlight-summary-deleted-face))
-	   ((string= temp-mark "O")
-	    (setq fsymbol 'wl-highlight-summary-copied-face
-		  dest t))
-	   ((string= temp-mark "o")
-	    (setq fsymbol 'wl-highlight-summary-refiled-face
-		  dest t)))))
-      (if (not fsymbol)
-	  (cond
-	   ((and (string= temp-mark "+")
-		 (member status-mark (list wl-summary-unread-cached-mark
-					   wl-summary-unread-uncached-mark
-					   wl-summary-new-mark)))
-	    (setq fsymbol 'wl-highlight-summary-high-unread-face))
-	   ((and (string= temp-mark "-")
-		 (member status-mark (list wl-summary-unread-cached-mark
-					   wl-summary-unread-uncached-mark
-					   wl-summary-new-mark)))
-	    (setq fsymbol 'wl-highlight-summary-low-unread-face))
-	   ((string= status-mark wl-summary-new-mark)
-	    (setq fsymbol 'wl-highlight-summary-new-face))
-	   ((member status-mark (list wl-summary-unread-cached-mark
-				      wl-summary-unread-uncached-mark))
-	    (setq fsymbol 'wl-highlight-summary-unread-face))
-	   ((string= status-mark wl-summary-important-mark)
-	    (setq fsymbol 'wl-highlight-summary-important-face))
-	   ;; score mark
-	   ((string= temp-mark "-")
-	    (setq fsymbol 'wl-highlight-summary-low-read-face))
-	   ((string= temp-mark "+")
-	    (setq fsymbol 'wl-highlight-summary-high-read-face))
-	   ;;
-	   (t (if (and looked-at
-		       (string= (buffer-substring
-				 (match-beginning 3)
-				 (match-end 3)) ""))
-		  (setq fsymbol 'wl-highlight-summary-thread-top-face)
-		(setq fsymbol 'wl-highlight-summary-normal-face)))))
-      (put-text-property bol eol 'face fsymbol)
-      (when dest
+      (setq spec (wl-highlight-summary-line-face-spec
+		  (elmo-message-flags wl-summary-buffer-elmo-folder
+				      number)
+		  (wl-summary-temp-mark)
+		  (wl-thread-entity-get-parent-entity
+		   (wl-thread-get-entity number))))
+      (when (car spec)
+	(put-text-property bol eol 'face (car spec)))
+      (when (cdr spec)
 	(put-text-property (next-single-property-change
 			    (next-single-property-change
-			     bol 'wl-summary-destination
+			     bol 'wl-summary-action-argument
 			     nil eol)
-			    'wl-summary-destination nil eol)
+			    'wl-summary-action-argument nil eol)
 			   eol
 			   'face
-			   'wl-highlight-refile-destination-face))
-      (if wl-use-highlight-mouse-line
-	  (put-text-property bol
-;;; Use bol instead of (1- (match-end 0))
-;;;			     (1- (match-end 0))
-			     eol 'mouse-face 'highlight))
-;;;   (put-text-property (match-beginning 3) (match-end 3)
-;;;			 'face 'wl-highlight-thread-indent-face)
-      ;; Dnd stuff.
-      (if wl-use-dnd
-	  (wl-dnd-set-drag-starter bol eol)))))
+			   'wl-highlight-action-argument-face))
+      (when wl-use-highlight-mouse-line
+	(put-text-property bol eol 'mouse-face 'highlight))
+      (when wl-use-flag-folder-help-echo
+	(wl-highlight-summary-line-flag-folder number bol eol))
+      (when wl-use-dnd
+	(wl-dnd-set-drag-starter bol eol)))))
 
 (defun wl-highlight-folder (start end)
   "Highlight folder between start and end.
@@ -958,9 +977,9 @@ Variables used:
 	  (overlay-put ov 'wl-momentary-overlay t))
 	(forward-line 1)))))
 
-(defun wl-highlight-refile-destination-string (string)
+(defun wl-highlight-action-argument-string (string)
   (put-text-property 0 (length string) 'face
-		     'wl-highlight-refile-destination-face
+		     'wl-highlight-action-argument-face
 		     string))
 
 (defun wl-highlight-summary-all ()
@@ -968,7 +987,7 @@ Variables used:
   (interactive)
   (wl-highlight-summary (point-min)(point-max)))
 
-(defun wl-highlight-summary (start end)
+(defun wl-highlight-summary (start end &optional lazy)
   "Highlight summary between start and end.
 Faces used:
   wl-highlight-summary-unread-face      unread messages
@@ -976,16 +995,7 @@ Faces used:
   wl-highlight-summary-deleted-face     messages mark as deleted
   wl-highlight-summary-refiled-face     messages mark as refiled
   wl-highlight-summary-copied-face      messages mark as copied
-  wl-highlight-summary-new-face         new messages
-
-Variables used:
-  wl-highlight-summary-unread-regexp    matches unread messages
-  wl-highlight-summary-important-regexp matches important messages
-  wl-highlight-summary-deleted-regexp   matches messages mark as deleted
-  wl-highlight-summary-refiled-regexp   matches messages mark as refiled
-  wl-highlight-summary-copied-regexp    matches messages mark as copied
-  wl-highlight-summary-new-regexp       matches new messages
-"
+  wl-highlight-summary-new-face         new messages"
   (if (< end start)
       (let ((s start)) (setq start end end s)))
   (let (lines too-big gc-message e p hend i percent)
@@ -998,17 +1008,9 @@ Variables used:
       (setq i 0)
       (while (and (not (eobp))
 		  (< (point) end))
-	(wl-highlight-summary-current-line nil nil
-					   (or wl-summary-lazy-highlight
-					       wl-summary-scored))
-	(when (and (not wl-summary-lazy-highlight)
-		   (> lines elmo-display-progress-threshold))
-	  (setq i (+ i 1))
-	  (setq percent (/ (* i 100) lines))
-	  (if (or (zerop (% percent 5)) (= i lines))
-	      (elmo-display-progress
-	       'wl-highlight-summary "Highlighting..."
-	       percent)))
+	(when (or (not lazy)
+		  (null (get-text-property (point) 'face)))
+	  (wl-highlight-summary-current-line))
 	(forward-line 1))
       (unless wl-summary-lazy-highlight
 	(message "Highlighting...done")))))
@@ -1016,14 +1018,17 @@ Variables used:
 (defun wl-highlight-summary-window (&optional win beg)
   "Highlight summary window.
 This function is defined for `window-scroll-functions'"
-  (if wl-summary-highlight
-      (with-current-buffer (window-buffer win)
-	(wl-highlight-summary (window-start win)
-			      (save-excursion
-				(goto-char (window-start win))
-				(forward-line (frame-height))
-				(point)))
-	(set-buffer-modified-p nil))))
+  (when wl-summary-highlight
+    (with-current-buffer (window-buffer win)
+      (when (eq major-mode 'wl-summary-mode)
+	(let ((start (window-start win))
+	      (end (condition-case nil
+		       (window-end win t) ;; old emacsen doesn't support 2nd arg.
+		     (error (window-end win)))))
+	  (wl-highlight-summary start
+				end
+				'lazy))
+	(set-buffer-modified-p nil)))))
 
 (defun wl-highlight-headers (&optional for-draft)
   (let ((beg (point-min))
@@ -1124,8 +1129,7 @@ interpreted as cited text.)"
 	(real-end end)
 	current  beg
 	e p hend)
-    (if too-big
-	nil
+    (unless too-big
       (save-excursion
 	(save-restriction
 	  (widen)
@@ -1154,29 +1158,27 @@ interpreted as cited text.)"
 	      (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))
-		 ;; ignore non-header field name lines
-		 (t (forward-line 1))))))
+		(if (looking-at "^[^ \t\n:]+[ \t]*:")
+		    (progn
+		      (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)))
+		      (or (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)))
+			  (put-text-property
+			   p hend 'face 'wl-highlight-message-header-contents))
+		      (goto-char hend))
+		  ;; ignore non-header field name lines
+		  (forward-line 1)))))
 	  (let (prefix prefix-face-alist pair end)
 	    (while (not (eobp))
 	      (cond
@@ -1239,6 +1241,9 @@ interpreted as cited text.)"
 	 (inhibit-read-only t))
     (put-text-property beg end 'mouse-face 'highlight)))
 
+
+(autoload 'elmo-flag-folder-referrer "elmo-flag")
+
 (require 'product)
 (product-provide (provide 'wl-highlight) (require 'wl-version))