;;; canna-cursor.el -- Specify current input mode: In canna or out of canna.

;; Author: Kazutaka SHIGENO <shigeno@vacation.kyushu-id.ac.jp>
;;         Hiroshi YOKOTA <yokota@netlab.is.tsukuba.ac.jp>
;; Maintainer: Hiroshi YOKOTA <yokota@netlab.is.tsukuba.ac.jp>
;; Version: 1.2
;; Keywords: canna color color-mate kanakan-cursor
;; Content-Type: text/plain; charset=x-euc-jp

;;; This program is distributed under the GNU GENERAL PUBLIC LICENSE.

;;;; Usage
;;; Put this file in emacs-lisp directory.
;;; And put (require 'canna-cursor) in your .emacs.
;;;  From edtion 4th, when the color map exhausting error occurs, The cursor 
;;; color is set canna-mode-off-cursor-color. And if the variable, 
;;; cursor-color-error-report-always is t, the error message is displayed on the
;;; mini-buffer always. This means:
;;; 
;;;  1) Don't setq canna-mode-off-cursor-colors in mule session.(?)
;;;

;;;; Note
;;; This code will work with mule2.x / {X,GNU}Emacs 20 running on window system.
;;; If you want to change the color for each input mode into "yellow",
;;; put (setq canna-mode-on-cursor-color "yellow") in your .emacs.

;;; History:
;; canna-cursor.el for Color-Mate Ver.1.2:
;;    o xemacs fix.
;; canna-cursor.el for Color-Mate Ver.1.1:
;;    o xemacs support.
;;    o Small change for leim conflict detect.
;; canna-cursor.el for Color-Mate Ver.1.0:
;;    o Port to Color-Mate.

;;; This code is derived from egg-cursor.el.

;-----------------------------------------------------------------;
;                canna-cursor.el for Color-Mate
;-----------------------------------------------------------------;
;$Id: canna-cursor.el,v 1.8 1999/08/05 23:33:54 elca Exp $

;;;; Code

(require 'canna)
(require 'color-mate-util)

;; Entry point, key
(global-set-key "\C-o" 'canna-toggle-japanese-mode-with-cursor-color)
(if (not (keymapp (global-key-binding "\e[")))
    (global-unset-key "\e[") )
(global-set-key "\e[210z" 'canna-toggle-japanese-mode) ; XFER
(define-key global-map [kanji] 'canna-toggle-japanese-mode)

;; Color Setup
(defvar canna-mode-on-cursor-color "forestgreen"
  "Cursor color for canna mode")
(defvar canna-mode-off-cursor-color nil
  "Cursor color for mode out of canna")

(defvar canna-cursor-color-bound-to-each-buffer nil
  "This variable will be referred when buffer is selected.
This is canna-cursor's buffer-local variable. Don't use it!")
(make-variable-buffer-local 'canna-cursor-color-bound-to-each-buffer)


;; 設定が無い時は初期設定のカーソル色を引き継ぐ
(if (not canna-mode-off-cursor-color)
    (setq canna-mode-off-cursor-color
	  (if (color-mate:is-xemacs)
	      (face-background-name 'text-cursor)
	    (cdr (assoc 'cursor-color (frame-parameters (selected-frame)))))
	  ))

;;------------------------------------------------
;; 他の kanakan-cursor プログラムとの連係用の変数
;;
(defvar canna-cursor-japanese-mode "init" "If \"on\", you are input words with canna.")
(defvar egg-cursor-japanese-mode "init" "If \"on\", you are input words with egg.")
(defvar skk-cursor-japanese-mode "init" "If \"on\", you are input words with skk.")
(defvar sj3-cursor-japanese-mode "init" "If \"on\", you are input words with sj3.")
(defvar leim-cursor-mode         "init" "If \"on\", you are input words with leim")
(make-variable-buffer-local 'canna-cursor-japanese-mode)
(make-variable-buffer-local 'egg-cursor-japanese-mode)
(make-variable-buffer-local 'skk-cursor-japanese-mode)
(make-variable-buffer-local 'sj3-cursor-japanese-mode)
(make-variable-buffer-local 'leim-cursor-mode)


(defun canna-toggle-japanese-mode-with-cursor-color ()
  "Wrapper function of canna-toggle-japanese-mode for cursor color management."
  (interactive)
  (canna-toggle-japanese-mode)
  (if canna:*japanese-mode*
      (progn
	(setq canna-cursor-color-bound-to-each-buffer
	      canna-mode-on-cursor-color)
	(setq canna-cursor-japanese-mode "on"))
    (progn
      (setq canna-cursor-color-bound-to-each-buffer
	    canna-mode-off-cursor-color)
	(setq canna-cursor-japanese-mode "off"))
    )
  (canna-cursor-set canna-cursor-japanese-mode)
  )

;;
;; re-define canna:select-window-hook
;;
; select-window-hook をフックする
; 他の kanakan-cursor モジュールとの競合を考えて２段構えにする
(setq select-window-hook
      '(lambda (old new)
	 (run-hook-with-args 'kanakan-cursor-select-window-hooks old new)))
(add-hook 'kanakan-cursor-select-window-hooks 'canna:select-window-hook)

(defun canna:select-window-hook (old new)
  (if (eq new (minibuffer-window))
      (progn
	(setq minibuffer-window-selected t)
	(if canna:*japanese-mode-in-minibuffer*
	    (progn
	      (setq canna-cursor-color-bound-to-each-buffer
		    canna-mode-on-cursor-color)
	      (setq canna-cursor-japanese-mode "on")
	      )))
    (setq minibuffer-window-selected nil))
  (save-excursion
    (set-buffer (window-buffer new))
    (canna-cursor-set canna-cursor-japanese-mode)))

;; add hook
(defadvice bury-buffer (after add-canna-cursor-set first activate)
  (canna-cursor-set canna-cursor-japanese-mode))
(defadvice kill-buffer (after add-canna-cursor-set first activate)
  (canna-cursor-set canna-cursor-japanese-mode))
(defadvice switch-to-buffer (after add-canna-cursor-set first activate)
  (canna-cursor-set canna-cursor-japanese-mode))

; for xemacs
(if (color-mate:is-xemacs)
    (progn
      (defadvice select-window (after add-canna-cursor-set first activate)
	(canna-cursor-set canna-cursor-japanese-mode))
      (defadvice other-window (after add-canna-cursor-set first activate)
	(canna-cursor-set canna-cursor-japanese-mode))
      (defadvice mouse-track (after add-canna-cursor-set first activate)
	(canna-cursor-set canna-cursor-japanese-mode))))

;; add hook
(add-hook 'after-make-frame-hook
	  (function
	   (lambda ()
	     (canna-cursor-set canna-cursor-japanese-mode))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; カーソル色設定
;; set cursor color
;;
;; canna, egg, skk, sj3, leim のどれか一つの漢字入力モードが on に
;; なっているとカーソル色を元に戻す事が出来なくなるようにしてある。
;;
(defun canna-cursor-set (mode)
  "Cursor color changer with conflict management."
  (progn
    (cond
     ((equal mode "on")
      (set-cursor-color canna-cursor-color-bound-to-each-buffer))
     ((equal mode "off")
      (if (not (or (equal egg-cursor-japanese-mode "on")
		   (equal skk-cursor-japanese-mode "on")
		   (equal leim-cursor-mode "on")
		   (equal sj3-cursor-japanese-mode "on")))
	  (set-cursor-color canna-cursor-color-bound-to-each-buffer)))
     ((equal mode "init")
      (if (not (or (equal egg-cursor-japanese-mode "on")
		   (equal skk-cursor-japanese-mode "on")
		   (equal leim-cursor-mode "on")
		   (equal sj3-cursor-japanese-mode "on")))
	  (set-cursor-color canna-mode-off-cursor-color)))
     )))


;; feature にする
(provide 'canna-cursor)

;;; canna-cursor.el ends here
