;;;
;;;  cmail-highlight.el - cmail highlight functions for emacs 19 or later
;;; 
;;;  Author:        Toshihiko Ueki <toshi@he.kobelcosys.co.jp>
;;;                 IWAMURO Motonori <iwa@mmp.fujitsu.co.jp>
;;;  Created:       1997/08/26
;;;  Last modified: 1998/09/05
;;;
;;;  Copyright (C) 1995-1998 Yukihiro Matsumoto.

;;; cmail-highlight.el

(provide 'cmail-highlight)
(require 'cmail)
(require 'timezone)

(defvar cmail-header-face-alist
  '(("Date"     nil                    cmail-header-date-face)
    ("From"     nil                    cmail-header-from-face)
    ("Reply-To" nil                    cmail-header-from-face)
    ("To"       nil                    cmail-header-to-cc-face)
    ("CC"       nil                    cmail-header-to-cc-face)
    ("Subject"  nil                    cmail-header-subject-face)
    (""         cmail-header-name-face cmail-header-content-face))
  "*Controls highlighting of message header.")

(make-face 'cmail-header-from-face)
(make-face 'cmail-header-subject-face)
(make-face 'cmail-header-date-face)
(make-face 'cmail-header-to-cc-face)
(make-face 'cmail-header-name-face)
(make-face 'cmail-header-content-face)
(make-face 'cmail-header-separator-face)
(make-face 'cmail-cite-face)
(make-face 'cmail-summary-mode-seen-face)
(make-face 'cmail-summary-mode-reply-face)
(make-face 'cmail-summary-mode-edited-face)
(make-face 'cmail-summary-mode-unread-face)
(make-face 'cmail-summary-mode-delete-face)
(make-face 'cmail-summary-mode-hold-face)
(make-face 'cmail-summary-mode-bookmark-face)
(make-face 'cmail-summary-mode-moreflags-face)
(make-face 'cmail-summary-mode-marked-face)
(make-face 'cmail-summary-mode-current-face)
(make-face 'cmail-folders-mode-dir-face)

(let ((map cmail-summary-mode-map))
  (define-key map "\C-cht"    'cmail-toggle-highlight-mode))

(defun cmail-toggle-highlight-mode (arg)
  (interactive "P")
  (setq cmail-highlight-mode
        (or arg (not cmail-highlight-mode)))
  (cmail-summary-set-overlay (get-buffer *cmail-summary-buffer)
			     cmail-highlight-mode)
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-narrow-to-head ()
  "Narrow the buffer to the header part of the message."
  (widen)
  (let ((sep0 (concat "^" mail-header-separator "$"))
	(sep1 "\n\n"))
    (narrow-to-region (goto-char (point-min))
		      (if (re-search-forward sep0 nil t)
			  (progn
			    (beginning-of-line)
			    (point))
			(if (search-forward sep1 nil t)
			    (1- (point))
			  (point-max)))))
  (goto-char (point-min)))

(defun cmail-narrow-to-message-body ()
  "Narrow the buffer to the body part of the message."
  (widen)
  (goto-char (point-min))
  (let ((sep0 (concat "^" mail-header-separator "\n"))
	(sep1 "\n\n"))
    (narrow-to-region (if (re-search-forward sep0 nil t)
			    (point)
			(if (search-forward sep1 nil t)
			    (1- (point))
		          (point-min)))
		      (point-max)))
  (goto-char (point-min)))

(defun cmail-put-text-property (start end prop value &optional object)
  (put-text-property start end prop value object)
  (put-text-property start end 'start-closed nil object))

(defun cmail-highlight-mail ()
  "Highlight mail."
  (interactive)
  (and cmail-highlight-mode
       (get-buffer *cmail-mail-buffer)
       (save-excursion
	 (set-buffer *cmail-mail-buffer)
	 (cmail-highlight-message))))

(defun cmail-highlight-message ()
  "Highlight mail buffer."
  (save-restriction
    (let ((modified-p (buffer-modified-p))
	  (buffer-read-only nil)
	  (case-fold-search t)
	  (inhibit-point-motion-hooks t))
      (let ((alist cmail-header-face-alist)
	    entry regexp header-face field-face from hpoints fpoints)
	(cmail-narrow-to-head)
	(while (setq entry (pop alist))
	  (goto-char (point-min))
	  (setq regexp (concat "^\\("
			       (if (string-equal "" (nth 0 entry))
				   "[^\t ]"
				 (nth 0 entry))
			       "\\)")
		header-face (nth 1 entry)
		field-face (nth 2 entry))
	  (while (and (re-search-forward regexp nil t) (not (eobp)))
	    (beginning-of-line)
	    (setq from (point))
	    (if (not (re-search-forward "[ \t]" nil t))
	      (forward-char 1))
	    (when (and header-face (not (memq (point) hpoints)))
	      (push (point) hpoints)
	      (cmail-put-text-property from (point) 'face header-face))
	    (when (and field-face (not (memq (setq from (point)) fpoints)))
	      (push from fpoints)
	      (if (re-search-forward "^[^ \t]" nil t)
		  (forward-char -2)
	        (goto-char (point-max)))
	      (cmail-put-text-property from (point) 'face field-face)))))
      (let ((regexp (concat "^" (regexp-quote mail-header-separator) "$")) from)
	(widen)
	(if (not (and (re-search-forward regexp nil t) (not (eobp))))
	    nil
	  (beginning-of-line)
	  (setq from (point))
	  (end-of-line)
	  (cmail-put-text-property from (point) 'face 'cmail-header-separator-face)))
      (if (and (featurep 'cmail-use-multi-highlight) cmail-use-multi-highlight)
	  (cmail-multi-highlight-mail-buffer)
	(let ((regexp1 cmail-cite-regexp) from)
	  (cmail-narrow-to-message-body)
	  (while (and (re-search-forward regexp1 nil t) (not (eobp)))
	    (beginning-of-line)
	    (setq from (point))
	    (end-of-line)
	    (cmail-put-text-property from (point) 'face 'cmail-cite-face))))
      (set-buffer-modified-p modified-p))))

(mapcar (function
	 (lambda (hook)
	    (add-hook hook 'cmail-highlight-mail)))
	'(cmail-show-contents-after-hook
	  cmail-crypt-after-decrypt/verify-hook
	  mime/viewer-mode-hook))

;;;
;;; Modified by IWAMURO Motonori <iwa@mmp.fujitsu.co.jp>
;;; Last modified: 1997/09/09
;;;

;;; swがtならバッファbufの各行にオーバーレイを張り付ける。
;;; swがnilならバッファbufの各行からオーバーレイを取り除く。
(defun cmail-summary-set-overlay (buf sw)
  (if buf
      (save-excursion
	(set-buffer buf)
	(goto-char (point-min))
	(condition-case nil
	    (while (not (eobp))
	      (let* ((pos (point))
		     (ov (overlays-at pos)))
		(end-of-line)
		(if sw
		    (if ov
			nil
		      (setq ov (make-overlay pos (point)))
		      (cmail-summary-update-overlay ov)
		      (overlay-put ov 'mouse-face cmail-highlight-mouse)
		      (overlay-put ov 'evaporate t))
		  (if ov
		      (delete-overlay (car ov))))
		(forward-char)))
	  (error nil)))))

;;; サマリ行のoverlayのfaceを更新する
(defun cmail-summary-update-overlay (ov)
  (let* ((begin (overlay-start ov))
	 (end (overlay-end ov))
	 (line (buffer-substring begin end)))
    (save-match-data
      (if (string-match "^[ +] *[0-9]+\\(.\\)" line)
	  (let ((mark (elt line (match-beginning 1))))
	    (overlay-put
	     ov 'face (cond
		       ((eq (elt line 0) ?+) 'cmail-summary-mode-current-face)
		       ((eq mark ? ) 'cmail-summary-mode-seen-face)
		       ((eq mark ?R) 'cmail-summary-mode-reply-face)
		       ((eq mark ?F) 'cmail-summary-mode-reply-face)
		       ((eq mark ?>) 'cmail-summary-mode-reply-face)
		       ((eq mark ?E) 'cmail-summary-mode-edited-face)
		       ((eq mark ?U) 'cmail-summary-mode-unread-face)
		       ((eq mark ?D) 'cmail-summary-mode-delete-face)
		       ((eq mark ?H) 'cmail-summary-mode-hold-face)
		       ((eq mark ?B) 'cmail-summary-mode-bookmark-face)
		       ((eq mark ?b) 'cmail-summary-mode-bookmark-face)
		       ((eq mark ?!) 'cmail-summary-mode-moreflags-face)
		       ((eq mark ?^) 'cmail-summary-mode-marked-face)))))
      )))

;;; サマリ行にoverlayを付加する
(defun cmail-summary-make-overlay (begin end ov)
  (if ov (move-overlay ov end (overlay-end ov)))
  (setq ov (make-overlay begin (1- end)))
  (cmail-summary-update-overlay ov)
  (overlay-put ov 'mouse-face cmail-highlight-mouse)
  (overlay-put ov 'evaporate t))

;;; サマリバッファのoverlayを制御する。after-change-functionsを通して
;;; 呼び出される
(defun cmail-summary-control-overlay (begin end prev-len)
  (if (and cmail-highlight-mode (zerop prev-len))
      (let ((ov (car (overlays-at begin))))
	(if (eq (char-after (1- end)) ?\n)
	    (cmail-summary-make-overlay begin end ov)
	  (cmail-summary-update-overlay ov)))))

;;; サマリバッファに色を付ける準備
(defun cmail-highlighting-summary-buffer ()
  (if cmail-highlight-mode
      (progn
	(make-local-variable 'after-change-functions)
	(add-hook 'after-change-functions
		  'cmail-summary-control-overlay))))

;;; サマリバッファが生成されたときに呼び出されるフック。
;;; cmail-summary-modeでバッファローカルな変数が全て削除されるので、
;;; cmail-summary-mode-hookにも追加している
(mapcar '(lambda (hook)
	   (add-hook hook 'cmail-highlighting-summary-buffer))
	'(cmail-summary-buffer-created-hook
	  cmail-summary-mode-hook))

;;; フォルダバッファのoverlayを設定する
(defun cmail-folders-set-overlay (pos)
  (if cmail-highlight-mode
      (save-excursion
	(mapcar 'delete-overlay (overlays-at pos))
	(goto-char pos)
	(end-of-line)
	(overlay-put
	 (make-overlay pos (point))
	 'face (cond
		((eq (char-after pos) ?\*)
		 'cmail-summary-mode-unread-face)
		((eq (char-after (1- (point))) ?/)
		 'cmail-folders-mode-dir-face)
		(t
		 'cmail-summary-mode-seen-face)))
	(overlay-put
	 (make-overlay (+ pos *cmail-folders-num-part-length 1) (point))
	 'mouse-face cmail-highlight-mouse)
	)))

(setq *cmail-folders-set-overlay 'cmail-folders-set-overlay)
