;;; skk-cursor.el -- Specify current input mode in skk with the cursor color.

;;; Copyright (C) 1995 Masatake YAMATO.

;; Author: Masatake YAMATO <scs30154@bkc.ritsumei.ac.jp>
;;         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.1
;; Keywords: skk color color-mate kanakan-cursor
;; Content-Type: text/plain; charset=x-euc-jp

;;; This file is part of kanakan-cursor.

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

;;; Usage: 
;; Install:
;; Replace skk setting sequences in .emacs or elsewhere like,
;; (global-set-key "\C-x\C-j" 'skk-mode) -> \
;; (global-set-key "\C-x\C-j" 'skk-mode-with-color-cursor)
;; (global-set-key "\C-xj" 'skk-auto-fill-mode) -> \
;; (global-set-key "\C-xj" 'skk-auto-fill-mode-with-color-cursor)
;;  And add these,
;; (autoload 'skk-mode-with-color-cursor "skk-cursor" nil t)
;; (autoload 'skk-auto-fill-mode-with-color-cursor "skk-cursor" nil t)
;;  *Note* From revision 7th, you don't have to use "require".
;;

;; History:
;; skk-cursor.el for Color-Mate Ver.1.1:
;;     o xemacs fix.
;; skk-cursor.el for Color-Mate Ver.1.0.1:
;;     o Small change for leim conflict detect.
;; skk-cursor.el for Color-Mate Ver.1.0:
;;     o Port to Color-Mate.
;;
;; 9th: Thu Dec 14 13:21:49 1995
;;     o Add new advices. Thanx to Mukunoki Masayuki<mukunoki@kuis.kyoto-u.ac.jp>.
;; 8th: Mon Dec 11 22:37:31 1995
;;     o Replace the function definition for the user working on console.
;; 7th: Mon Dec 11 19:01:38 1995
;;     o post-command-hook is never used !
;;      New codes is borrowed from egg-cursor.el,5th-draft.
;;      Thanx to Mukunoki Masayuki<mukunoki@kuis.kyoto-u.ac.jp>
;;      and "defadvice" !
;;     o Installing style is changed.
;;      Now, use not require but autoload to install.
;;      Thanx to bug report Tsunehiko Baba<tbaba@mtl.t.u-tokyo.ac.jp>.
;; 6th: Mon Nov 27 15:44:14 1995
;;     o Change the license and copyright.
;;     o A bug(The behavior of j-toggle-kana-with-color-cursor in 
;;      j-henakan-on) is fixed.
;; 5th: Tue Nov 14 19:26:08 1995
;;     o Evade the color map exhausting error.
;; 4th: Wed Oct 25 15:13:51 1995
;;     o Remove start up bug.
;;     o Window system and emacs-version checking code borrowed 
;;      form canna-cursor.el by Kazutaka SHIGENO <shigeno@vacation.kyushu-id.ac.jp>.
;;     o Now skk-auto-fill-mode-with-color-cursor available.
;; 3rd: Tue Oct 24 19:20:16 1995
;;     o Some code borrowed from my egg-cursor.el
;;     o Some bug fiexd.
;;     o Thanks to isobe@suri.co.jp for reporting bug.
;;     o Use mule init cursor color as cursor-color-for-default.
;;      If you define cursor color in .Xdefaults or .emacs, that will be used as 
;;      cursor-color-for-default.
;;     o Change the default cursor-color-for-kana.
;; 2nd: Mon Oct 23 18:53:01 1995
;;     o Thanks to IKEMOTO Masahiro<ikeyan@airlab.cs.ritsumei.ac.jp>
;;      for good suggestion. 
;;     o Old cursor color is taken shelter. 
;;     o Make cursor color buffer local and check it with hook.
;;     o Check window system.
;;     o Distribute to a few classmates from this revision.
;; 1st: Mon Oct 23 12:08:53 1995


;-------------------------------------------------------------
;              skk-cursor.el for Color-Mate
;-------------------------------------------------------------
;$Id: skk-cursor.el,v 1.7 1999/08/05 23:36:10 elca Exp $


;;; Code
(require 'skk)
(require 'color-mate-util)

;; example color setting: change you like
(defvar skk-cursor-color-for-default nil "Cursor color for not in skk.") 
(defvar skk-cursor-color-for-zenkaku-eiji "gold" "*Cursor color for zenkaku eiji mode.")
(defvar skk-cursor-color-for-katakana "coral4" "*Cursor color for katakana mode.")
(defvar skk-cursor-color-for-kana "forestgreen" "*Cursor color for kana mode.")
(defvar skk-cursor-color-for-eiji nil "*Cursor color for eiji mode.")

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

;; This variable is made buffer local.
(defvar skk-cursor-color-bound-to-each-buffer nil
  "This variable will be referd when buffer is selected.
This variable is buffer local. Dont'use it!")
(make-variable-buffer-local 'skk-cursor-color-bound-to-each-buffer)

;;
;; 他の 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)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                             Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A wrapper for the function 'skk-mode'
;;
(defun skk-mode-with-color-cursor (&optional arg)
  "skk-mode with cursor color management."
  (interactive "P")
  (if skk-mode
      (progn
	(skk-mode arg)
	(setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-default)
	(setq skk-cursor-japanese-mode "off")
	(skk-cursor-set skk-cursor-japanese-mode))
    (skk-mode arg)
    ;; ???
    (define-key skk-map "l" 'j-mode-off-with-color-cursor)
    (define-key skk-map "q" 'j-toggle-kana-with-color-cursor)
    (define-key j-emacs-local-map "\C-j" 'j-kakutei-with-color-cursor)
    (define-key skk-map "L" 'j-zenkaku-eiji-with-color-cursor)
    (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-kana)
    (setq skk-cursor-japanese-mode "on")
    (skk-cursor-set skk-cursor-japanese-mode)))

(defun skk-auto-fill-mode-with-color-cursor (arg)
  "skk-auto-fill-mode with color management."
  (interactive "P")
  (if skk-mode
      (skk-auto-fill-mode arg)
    (skk-auto-fill-mode arg)
    ;; ???
    (define-key skk-map "l" 'j-mode-off-with-color-cursor)
    (define-key skk-map "q" 'j-toggle-kana-with-color-cursor)
    (define-key j-emacs-local-map "\C-j" 'j-kakutei-with-color-cursor)
    (define-key skk-map "L" 'j-zenkaku-eiji-with-color-cursor)
    (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-kana)
    (setq skk-cursor-japanese-mode "on")
    (skk-cursor-set skk-cursor-japanese-mode)))

(defun j-zenkaku-eiji-with-color-cursor (arg)
  "j-zenkaku-eiji with cursor color management."
  (interactive "P")
  (if (and j-mode skk-mode)
      (progn
	(j-zenkaku-eiji)
	(setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-zenkaku-eiji)
	(setq skk-cursor-japanese-mode "on")
	(skk-cursor-set skk-cursor-japanese-mode)
	(define-key skk-zenkaku-map "\C-j" 'j-kakutei-with-color-cursor))
    (self-insert-command (prefix-numeric-value arg))))

(defun j-toggle-kana-with-color-cursor(arg)
  "j-katakana with cursor color management."
  (interactive "P")
  (if skk-mode
      (if (not j-henkan-on)
	  (if (not j-katakana)
	      (progn
		(setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-katakana)
		(setq skk-cursor-japanese-mode "on")
		(skk-cursor-set skk-cursor-japanese-mode)
		(j-toggle-kana arg))
	    (if j-katakana
		(progn
		  (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-kana)
		  (setq skk-cursor-japanese-mode "on")
		  (skk-cursor-set skk-cursor-japanese-mode)
		  (j-toggle-kana arg))
	      (if (not j-mode)
		  (self-insert-command (prefix-numeric-value arg)))))
	(j-toggle-kana arg)
	;; Dirty!
	(if j-katakana
	    (progn
	      (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-katakana)
	      (setq skk-cursor-japanese-mode "on")
	      (skk-cursor-set skk-cursor-japanese-mode))
	  (progn
	    (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-kana)
	    (setq skk-cursor-japanese-mode "on")
	    (skk-cursor-set skk-cursor-japanese-mode))))
    (self-insert-command (prefix-numeric-value arg))))

(defun j-mode-off-with-color-cursor (arg)
  "j-mode-off with cursor color management."
  (interactive "P")
  (if (and j-mode skk-mode)
      (progn
	(setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-eiji)
	(setq skk-cursor-japanese-mode "off")
	(skk-cursor-set skk-cursor-japanese-mode)
	(j-mode-off))
    (self-insert-command (prefix-numeric-value arg))))

(defun j-kakutei-with-color-cursor (&optional word)
  "j-kakutei with cursor color management."
  (interactive)
  (if (and (not j-mode) skk-mode)
      (progn
	(if j-katakana
	    (progn
	      (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-katakana)
	      (setq skk-cursor-japanese-mode "on")
	      (skk-cursor-set skk-cursor-japanese-mode))
	  (setq skk-cursor-color-bound-to-each-buffer skk-cursor-color-for-kana)
	  (setq skk-cursor-japanese-mode "on")
	  (skk-cursor-set skk-cursor-japanese-mode))
	  (j-kakutei))
    (j-kakutei)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Add hooks
(add-hook 'minibuffer-setup-hook
	  (function (lambda ()
		      (setq skk-cursor-japanese-mode "off")
		      (set-cursor-color skk-cursor-color-for-default)
		      )))

(add-hook 'minibuffer-exit-hook
	  (function (lambda ()
		      (if skk-cursor-color-bound-to-each-buffer
			  (skk-cursor-set skk-cursor-japanese-mode)
			(setq skk-cursor-color-bound-to-each-buffer
			      skk-cursor-color-for-default)
			(setq skk-cursor-japanese-mode "off")
			(skk-cursor-set skk-cursor-japanese-mode)
			))))

; 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 'skk:select-window-hook)

(defun skk:select-window-hook (old new)
  (save-excursion
    (set-buffer (window-buffer new))
    (skk-cursor-set skk-cursor-japanese-mode)))

;; Add hooks with defadvice
(defadvice bury-buffer (after add-skk-cursor-set first activate)
  (skk-cursor-set skk-cursor-japanese-mode))

(defadvice kill-buffer (after add-skk-cursor-set first activate)
  (skk-cursor-set skk-cursor-japanese-mode))

(defadvice switch-to-buffer (after add-skk-cursor-set first activate)
  (skk-cursor-set skk-cursor-japanese-mode))

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

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

(provide 'skk-cursor)

;;; skk-cursor.el ends here
