;;; cmail-use-multi-highlight.el --- highlight cited lines

;; Author: Keisuke ICHIHASHI <ksuke@tky2.3web.ne.jp>
;; Keywords: mail
;; Create Date: 2000-08-07
;; $Id: cmail-use-multi-highlight.el,v 1.2 2002/07/20 23:09:58 tmp Exp $

;; This file is part of cmail (a mail utility for GNU Emacs)

;; This file 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.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Installation:
;;	Put this line in your ~/.emacs
;; 		(setq cmail-use-multi-highlight t)
;;
;;	If you change cmail-cite-regexp or cmail-font-lock-keywords, use
;;	cmail-use-multi-highlight-load-hook.

;;; Code:
(eval-when-compile (require 'cmail-vars))

(defvar cmail-multi-highlight-attribute-alist
  '((cmail-highlight-cited-text-1    "ForestGreen"   nil          nil  nil)
    (cmail-highlight-cited-text-2    "brown"         nil          nil  nil)
    (cmail-highlight-cited-text-3    "Yellow4"       nil          nil  nil)
    (cmail-highlight-cited-text-4    "purple1"       nil          nil  nil)
    (cmail-highlight-cited-text-5    "blue1"         nil          nil  nil)
    (cmail-highlight-cited-text-6    "Red"           nil          nil  nil)
    (cmail-highlight-cited-text-7    "DarkGreen"     nil          nil  nil)
    (cmail-highlight-cited-text-8    "LimeGreen"     nil          nil  nil)
    (cmail-highlight-cited-text-9    "Gray35"        nil          nil  nil)
    (cmail-highlight-cited-text-10   "Cyan3"         nil          nil  nil))
  "*face名, 表面色, 背景色, boldやitalicを使用するかどうかのface alist.

デフォルト値は以下のとおり.
((cmail-highlight-cited-text-1    \"ForestGreen\"   nil          nil  nil)
 (cmail-highlight-cited-text-2    \"brown\"         nil          nil  nil)
 (cmail-highlight-cited-text-3    \"Yellow4\"       nil          nil  nil)
 (cmail-highlight-cited-text-4    \"purple1\"       nil          nil  nil)
 (cmail-highlight-cited-text-5    \"blue1\"         nil          nil  nil)
 (cmail-highlight-cited-text-6    \"Red\"           nil          nil  nil)
 (cmail-highlight-cited-text-7    \"DarkGreen\"     nil          nil  nil)
 (cmail-highlight-cited-text-8    \"LimeGreen\"     nil          nil  nil)
 (cmail-highlight-cited-text-9    \"Gray35\"        nil          nil  nil)
 (cmail-highlight-cited-text-10   \"Cyan3\"         nil          nil  nil))

もし, 背景色が暗い配色である場合, デフォルト値の代りに以下の値を
試すと良いかも知れない.
((cmail-highlight-cited-text-1    \"HotPink1\"       nil          nil  nil)
 (cmail-highlight-cited-text-2    \"SeaGreen2\"      nil          nil  nil)
 (cmail-highlight-cited-text-3    \"Gold\"           nil          nil  nil)
 (cmail-highlight-cited-text-4    \"SkyBlue\"        nil          nil  nil)
 (cmail-highlight-cited-text-5    \"pink1\"          nil          nil  nil)
 (cmail-highlight-cited-text-6    \"Yellow\"         nil          nil  nil)
 (cmail-highlight-cited-text-7    \"Cyan\"           nil          nil  nil)
 (cmail-highlight-cited-text-8    \"GreenYellow\"    nil          nil  nil)
 (cmail-highlight-cited-text-9    \"Gray75\"         nil          nil  nil)
 (cmail-highlight-cited-text-10   \"wheat\"          nil          nil  nil))"
)

(defvar cmail-multi-highlight-citation-face-list nil)

;;;
(defun cmail-set-multi-highlight (symbol value)
  (setq cmail-use-multi-highlight value)
  (when cmail-use-multi-highlight
    (setq cmail-cite-regexp
	  (concat "^\\(In article\\|In message\\)"
		  "\\|^\\(\\([>|:} ]*[>|:}]\\)\\|\\( *[^ <\n>|}]+[>|}]\\)\\)+"))
    (setq cmail-font-lock-keywords
	  (let* ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
	    `((,(concat "^\\([Tt]o:\\)" content)
	       (1 'cmail-header-name-face)
	       (2 'cmail-header-from-face nil t))
	      (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
	       (1 'cmail-header-name-face)
	       (2 'cmail-header-from-face nil t))
	      (,(concat "^\\([Ss]ubject:\\)" content)
	       (1 'cmail-header-name-face)
	       (2 'cmail-header-subject-face nil t))
	      (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
	       (1 'cmail-header-name-face)
	       (2 'cmail-header-content-face nil t))
	      (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
	       (1 'cmail-header-name-face)
	       (2 'cmail-header-name-face))
	      (,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
	       1 'cmail-header-separator-face))))
    (cmail-multi-highlight-make-face)
    (mapcar '(lambda (hook)
	       (add-hook hook
			 '(lambda () (cmail-modify-keywords-highlight-citation nil)) t))
	    '(cmail-mail-hook
	      mime/editor-mode-hook))
    ))

(defun cmail-multi-highlight-make-face ()
  (let ((alist cmail-multi-highlight-attribute-alist) entry name fore back bold italic)
    (while (setq entry (pop alist))
      (setq name (nth 0 entry)
	    fore (nth 1 entry)
	    back (nth 2 entry)
	    bold (nth 3 entry)
	    italic (nth 4 entry))
      (make-face name)
      (if fore (set-face-foreground name fore))
      (if back (set-face-background name back))
      (cond ((featurep 'xemacs)
	     (if (and bold italic)
		 (set-face-font name [bold-italic])
	       (if bold (set-face-font name [bold]))
	       (if italic (set-face-font name [italic]))))
	    (t
	     (if bold (set-face-bold-p name bold))
	     (if italic (set-face-italic-p name italic))))
      (setq cmail-multi-highlight-citation-face-list
	    (append cmail-multi-highlight-citation-face-list
		    (list name)))
      )))

(defun cmail-multi-highlight-mail-buffer ()
  (let (prefix-list str)
    (cmail-narrow-to-message-body)
    (goto-char (point-min))
    (while (and (re-search-forward cmail-cite-regexp nil t)
		(not (eobp)))
      (setq str (format "%s" (buffer-substring (match-beginning 0) (match-end 0))))
      (unless (member str prefix-list)
	(setq prefix-list (append prefix-list (list str))))
      (end-of-line)
      (cmail-put-text-property (match-end 0)
			       (point)
			       'face
			       (nth (% (- (length prefix-list) (length (member str prefix-list)))
				       (length cmail-multi-highlight-citation-face-list))
				    cmail-multi-highlight-citation-face-list)
			       ))))

(defun cmail-modify-keywords-highlight-citation (force &optional buf)
  "Modify cmail font-lock-keywords."
  (save-excursion
    (when (or force
	      (= (1- (length font-lock-keywords)) (length cmail-font-lock-keywords)))
      (if buf (set-buffer buf))
      (let ((keywords cmail-font-lock-keywords)
	    (flen (length cmail-multi-highlight-citation-face-list))
	    (n 0)
	    str prefix-list prefix-alist)
	(goto-char (point-min))
	(re-search-forward (format "^%s$\\|\n\n" (regexp-quote mail-header-separator)) nil t)
	(while (and (re-search-forward cmail-cite-regexp nil t) (not (eobp)))
	  (setq str (format "%s" (buffer-substring (match-beginning 0) (match-end 0))))
	  (unless (member str prefix-list)
	    (setq prefix-list (cons str prefix-list)
		  prefix-alist (cons (cons str n) prefix-alist)
		  n (1+ n))))
  	(setq prefix-list (sort prefix-list 'string-lessp))
	(while prefix-list
	  (setq keywords
		(cons (list (concat "^" (regexp-quote (car prefix-list)) "\\(.+\\)$")
			    (list
			     1
			     (list 'quote (nth (% (cdr (assoc (car prefix-list) prefix-alist)) flen) cmail-multi-highlight-citation-face-list))))
		      keywords)
		prefix-list (cdr prefix-list)))
	(set (make-variable-buffer-local 'font-lock-keywords) keywords)
	(font-lock-mode 1)
	(font-lock-fontify-buffer)))))

;;; 
(cmail-i18n-defgroup cmail-use-multi-highlight-group nil
  ((ja_JP . "引用文のハイライトに関する設定。")
   (en_US . "Setting about highlight cited line."))
  :group 'cmail-other-features)

(cmail-i18n-defcustom cmail-use-multi-highlight nil
  ((ja_JP . "*Non-nil ならば、引用した人ごとに異る色でハイライトする。")
   (en_US . "*Non-nil means highlight different colors by citation."))
  :type 'boolean
  :set 'cmail-set-multi-highlight
  :group 'cmail-all-variables
  :group 'cmail-use-multi-highlight-group)
(cmail-custom-add-init 'cmail-set-multi-highlight 'cmail-use-multi-highlight)

(cmail-i18n-defcustom cmail-use-multi-highlight-load-hook nil
  ((ja_JP . "cmail-use-multi-highlight がロードされたときに実行されるフック")
   (en_US . "A hook called when load cmail-use-multi-highlight."))
  :type 'hook
  :group 'cmail-all-variables
  :group 'cmail-use-multi-highlight-group)

(run-hooks 'cmail-use-multi-highlight-load-hook)

(provide 'cmail-use-multi-highlight)

;;; cmail-use-multi-highlight.el ends here