;;; skk-show-mode.el --- モード切替時に tooltip/inline 表示する -*- coding: iso-2022-jp -*-

;; Copyright (C) 2011 Tsuyoshi Kitamoto  <tsuyoshi.kitamoto@gmail.com>

;; Author: 2011 Tsuyoshi Kitamoto  <tsuyoshi.kitamoto@gmail.com>
;; Maintainer: SKK Development Team <skk@ring.gr.jp>
;; Keywords: japanese, mule, input method

;; This file is part of Daredevil SKK.

;; Daredevil SKK 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.

;; Daredevil SKK 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 Daredevil SKK, see the file COPYING.  If not, write to
;; the Free Software Foundation Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;; 
;;  ~/.skk にて
;;      (setq skk-show-mode-show t)
;;  と設定してください。
;;  Emacs 起動中は M-x skk-show-mode でトグルすることができます。

;;  変数 skk-show-mode-style に 'tooltip 又は 'inline を設定してください。

;;; Code:

(eval-when-compile
  (require 'skk-vars))

(defadvice skk-isearch-set-initial-mode (before skk-show-mode activate)
  (setq skk-show-mode-show nil))

(defadvice skk-isearch-initialize-working-buffer (before skk-show-mode activate)
  (setq skk-show-mode-show nil))

(defadvice skk-cursor-set (after skk-show-mode activate)
  "かなモードやアスキーモードへ切り替わったときに skk-*-mode-string を
tooltip / inline 表示する."
  (when (and skk-show-mode-invoked
	     skk-show-mode-show
	     (not skk-isearch-switch))
    (let ((func (cdr (assq skk-show-mode-style skk-show-mode-functions))))
      (when func
	(funcall func))))
  (setq skk-show-mode-invoked t))

(defun skk-show-mode-inline ()
  (let ((skk-henkan-start-point (point))
	string)
    (unless (skk-in-minibuffer-p)
      (cond
       (skk-abbrev-mode
	(setq string skk-abbrev-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-abbrev-color))
       (skk-jisx0208-latin-mode
	(setq string skk-jisx0208-latin-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-jisx0208-latin-color))
       (skk-katakana
	(setq string skk-katakana-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-katakana-color))
       (skk-j-mode
	(setq string skk-hiragana-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-hiragana-color))
       (skk-jisx0201-mode
	(setq string skk-jisx0201-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-jisx0201-color))
       (t
	(setq string skk-latin-mode-string)
	(set-face-foreground 'skk-show-mode-inline-face skk-cursor-latin-color)))
      ;;
      (skk-show-mode-inline-1 string)))

  (sit-for 0.5)
  (skk-delete-overlay skk-show-mode-inline-overlays))

(defun skk-show-mode-inline-1 (str)
  ;; skk-dcomp-multiple-show() から拝借
  (let* ((margin 1)
	 (beg-col (max 0 (- (skk-screen-column) margin)))
	 (max-width (string-width str))
	 bottom col ol)
    (when (zerop beg-col)
      (setq margin 0))
    (setq str (propertize (concat (make-string margin 32)
				  str
				  (make-string margin 32))
			  'face 'skk-show-mode-inline-face))
    (save-excursion
      (scroll-left (max 0
			(- (+ beg-col margin max-width margin 1)
			   (window-width) (window-hscroll))))
      (setq bottom (zerop (vertical-motion 1)))
      (cond (bottom
	     ;; バッファ最終行では、普通に overlay を追加していく方法だと
	     ;; overlay の表示される順番が狂うことがあってうまくない。
	     ;; したがって前回の overlay の after-string に追加する。
	     ;; ただし、EOB の場合は prefix の overlay と衝突するため
	     ;; `skk-prefix-overlay' に追加する
	     (setq ol (cond ((or (not skk-echo)
				 (string= "" skk-prefix)
				 (< (overlay-end skk-prefix-overlay)
				    (point)))
			     (make-overlay (point) (point)))
			    (t skk-prefix-overlay)))

	     (setq str (concat (overlay-get ol 'after-string)
				     "\n" (make-string beg-col ? ) str)))
	    ;; bottom 以外
	    (t
	     (setq col (skk-move-to-screen-column beg-col))
	     (cond ((> beg-col col)
		    ;; 桁合わせの空白を追加
		    (setq str (concat (make-string (- beg-col col) ? )
				      str)))
		   ;; overlay の左端がマルチ幅文字と重なったときの微調整
		   ((< beg-col col)
		    (backward-char)
		    (setq col (skk-screen-column))
		    (setq str (concat (make-string (- beg-col col) ? )
				      str))))))

      ;; この時点で overlay の開始位置に point がある
      (unless bottom
	(let ((ol-beg (point))
	      (ol-end-col (+ col (string-width str)))
	      base-ol)
	  (setq col (skk-move-to-screen-column ol-end-col))
	  ;; overlay の右端がマルチ幅文字と重なったときの微調整
	  (when (< ol-end-col col)
	    (setq str (concat str
			      (make-string (- col ol-end-col) ? ))))
	  (setq ol (make-overlay ol-beg (point)))

	  ;; 元テキストの face を継承しないように1つ後ろに overlay を作って、
	  ;; その face を 'default に指定しておく
	  (setq base-ol (make-overlay (point) (1+ (point))))
	  (overlay-put base-ol 'face 'default)
	  (push base-ol skk-show-mode-inline-overlays)
	  )))

    (overlay-put ol 'invisible t)
    (overlay-put ol 'after-string str)
    (push ol skk-show-mode-inline-overlays)))


(defun skk-show-mode-tooltip ()
  (when window-system
    (let ((indicator
	   (apply 'skk-mode-string-to-indicator
		  (cond
		   (skk-abbrev-mode
		    `(abbrev ,skk-abbrev-mode-string))
		   (skk-jisx0208-latin-mode
		    `(jisx0208-latin ,skk-jisx0208-latin-mode-string))
		   (skk-katakana
		    `(katakana ,skk-katakana-mode-string))
		   (skk-j-mode
		    `(hiragana ,skk-hiragana-mode-string))
		   (skk-jisx0201-mode
		    `(jisx0201 ,skk-jisx0201-mode-string))
		   (t
		    `(latin ,skk-latin-mode-string))))))
      (skk-tooltip-show-at-point indicator))))

;;;###autoload
(defun skk-show-mode ()
  (interactive)
  (message "skk-show-mode-show: %s"
	   (setq skk-show-mode-show (null skk-show-mode-show))))
(provide 'skk-show-mode)

;;; skk-show-mode.el ends here