;;; Emacsではこのファイルを-*-emacs-lisp-*-モードで編集します。

;;; .tc - Tコードドライバーtc2用設定ファイル
;;; Author: KITAJIMA Akira <kitajima@ics.es.osaka-u.ac.jp>

;;; tc.el をロードする前に必要な設定
(defvar tcode-data-directory "~/.Env/T-Code/")
(defvar tcode-load-immediate nil)
(setq tcode-bushu-on-demand 2)

(if (boundp 'input-method-function)
    (setq tcode-use-input-method t)) ; ***EXPERIMENTAL***


;;; `tcode-auto-help', `tcode-verbose-message', `tcode-display-help-delay'
;;; を有効にするためには次の行が必要。
(setq input-method-verbose-flag nil)

(and window-system
     (global-set-key [menu] 'toggle-input-method))

;;; tc.el の設定
(add-hook 'tcode-ready-hook
	  (function
	   (lambda ()
	     (setq tcode-use-postfix-bushu-as-default t
		   tcode-auto-remove-help-count 5
		   tcode-adjust-window-for-help t
		   tcode-verbose-message nil
		   tcode-isearch-enable-wrapped-search t
		   tcode-auto-help t
;		   tcode-auto-help 'delete-the-char
		   tcode-mode-on-cursor-color "DarkCyan"
		   tcode-space-chars-list '(?  ?\n ?\t ?\{ ?\[ ?\()
		   tcode-record-file-name
		   (concat tcode-data-directory ".tc-record"))

	     (add-hook 'post-command-hook 'tcode-auto-remove-help)
	     (or (assq 'c-electric-semi&comma tcode-self-inserting-commands)
		 (setq tcode-self-inserting-commands
		       (cons '(c-electric-semi&comma . "P")
			     tcode-self-inserting-commands)))
	     (add-hook 'c-mode-common-hook
		       '(lambda ()
			  (setq tcode-isearch-start-state 0)))
	     ;; キー割り当ての変更
	     (when window-system
	       (global-set-key [menu] 'toggle-input-method)
	       ;; set tcode mode key for dvorak keyboard
	       (tcode-map-to-dvorak)
	       (set-tcode-mode-key ?/ nil))
	     ;;; シフトはそのまま大文字
	     (mapcar
	      (function
	       (lambda (key)
		 (set-tcode-mode-key key nil -1)))
	      '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N
		   ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z))
	     ;; その他のキーへのコマンドの割り当て
	     (mapcar
	      ;; set tcode mode key
	      (function (lambda (elm)
			  (let ((key (car elm))
				(command (cdr elm)))
			    (set-tcode-mode-key key command))))
	      ;; bindings
	      '((?\\ . toggle-tcode-mode-and-self-insert)
		(?@ . toggle-tcode-mode-and-self-insert)
		(?$ . toggle-tcode-mode-and-self-insert)
;		(?~ . toggle-tcode-mode-and-self-insert)
		(?!  . tcode-mazegaki-delete-by-last-yomi)
		(?\( . toggle-tcode-mode-and-self-insert)
		(?{ . abbrev-prefix-mark)
		(?} . expand-abbrev)
		(?`  . toggle-input-method)
		(?%  . tcode-katakana-previous-char)
		(?-  . tcode-insert-ya-outset)
		(? . tcode-electric-space)))
	     ;;; カーソルの色
	     (and window-system
		  (tcode-enable-cursor-to-change-color)
		  (add-hook 'tcode-toggle-hook
			    'tcode-enable-cursor-to-change-color))
	     (if (tcode-mule-4-p)
		 (require 'tc-complete)))))


;;; Dvorak 配列へ
(defun tcode-map-to-dvorak ()
  (interactive)
  (mapcar
      ;; set tcode mode key
      (function (lambda (elm)
		  (let ((code (car elm))
			(key (cdr elm)))
		    (set-tcode-mode-key key nil code))))
      ;; mapping
      '(( 0 .  ?1) ( 1 . ?2) ( 2 . ?3) ( 3 . ?4) ( 4 . ?5)    ; 一段目左
	( 5 .  ?6) ( 6 . ?7) ( 7 . ?8) ( 8 . ?9) ( 9 . ?0)    ; 一段目右

	(10 .  ?') (11 . ?,) (12 . ?.) (13 . ?p) (14 . ?y)    ; 二段目左
	(15 .  ?f) (16 . ?g) (17 . ?c) (18 . ?r) (19 . ?l)    ; 二段目右

	(20 .  ?a) (21 . ?o) (22 . ?e) (23 . ?u) (24 . ?i)    ; 三段目左
	(25 .  ?d) (26 . ?h) (27 . ?t) (28 . ?n) (29 . ?s)    ; 三段目右

	(30 . ?\;) (31 . ?q) (32 . ?j) (33 . ?k) (34 . ?x)    ; 四段目左
	(35 .  ?b) (36 . ?m) (37 . ?w) (38 . ?v) (39 . ?z)))) ; 四段目右

;;; 交ぜ書き変換に関する設定

(add-hook 'tcode-mazegaki-init-hook
	  '(lambda ()
	     (setq tcode-mazegaki-priority-list
                   ;; キー配置
		   ;;  0  1  2  3  4    5  6  7  8  9
		   ;; 10 11 12 13 14   15 16 17 18 19
		   ;; 20 21 22 23 24   25 26 27 28 29
		   ;; 30 31 32 33 34   35 36 37 38 39
		   '(22 23 21 24 20
			12 13 11 14 10)
		   tcode-mazegaki-alternative-select-left-keys
		   '(22)
		   tcode-mazegaki-alternative-select-right-keys
		   '(23))
	     (setq tcode-mazegaki-yomi-max 8)
	     (set-tcode-mode-key " " 'tcode-electric-space)
	     (when (and window-system
			(tcode-mule-4-p))
	       (set-face-background 'mazegaki-henkan "white")
	       (make-face-unbold 'mazegaki-henkan))))

;;;; tc-util

;; 句読点等の切り替え
(defvar tcode-left-paren "(" "* 開き括弧")
(make-variable-buffer-local 'tcode-left-paren)
(defvar tcode-right-paren ")" "* 閉じ括弧")
(make-variable-buffer-local 'tcode-right-paren)
(defvar tcode-switch-table-list
  '(;; デフォールト
    ((tcode-touten . "、")
     (tcode-kuten . "。")
     (tcode-left-paren . "(")
     (tcode-right-paren . ")"))
    ;; 1バイト系
    ((tcode-touten . ", ")
     (tcode-kuten . ". ")
     (tcode-left-paren . "(")
     (tcode-right-paren . ")"))
    ;; 2バイト系
    ((tcode-touten . "，")
     (tcode-kuten . "．")
     (tcode-left-paren . "（")
     (tcode-right-paren . "）"))))

(add-hook 'tcode-after-load-table-hook
	  (function
	   (lambda ()
	     ;; 2ストローク以上のキーの変更
	     (when (eq tcode-input-method 'tcode)
	       ;; ○自分の名前の字は2ストロークで。
	       ;; 島→嶋
	       (tcode-set-action-to-table '(18 10) "嶋")
	       ;; 焼→暁
	       (tcode-set-action-to-table '(6 12) "暁")
	       ;; ○大阪人やったら阪は打てな。
	       ;; 坂→阪
	       (tcode-set-action-to-table '(34 29) "阪")
	       ;; ○専門分野で使う字
	       ;; 竹→符
	       (tcode-set-action-to-table '(10 37) "符")
	       ;; ○個人的によく使う字
	       ;; 卜→削
	       (tcode-set-action-to-table '(13 4) "削")
	       ;; 兵→浜
	       (tcode-set-action-to-table '(31 25) "浜")
	       ;; ―→…
	       (tcode-set-action-to-table '(27 32) "…")

;		   (tcode-set-action-to-table '(27 12)
;					      (function
;					       (lambda ()
;						 (tcode-insert-matching-pair
;						  tcode-left-paren
;						  tcode-right-paren
;						  current-prefix-arg))))
	       (tcode-set-action-to-table '(27 12)
					  'tcode-left-paren)
;		   (tcode-set-action-to-table '(37 24)
;					      (function
;					       (lambda ()
;						 (tcode-insert-matching-pair
;						  "「" "」"
;						  current-prefix-arg))))
	       (tcode-set-action-to-table '(17 22)
					  'tcode-right-paren)))))

;;; モードの切り替え
(require 'tc-util)
(global-set-key " " 'tcode-electric-space)
(global-set-key "," 'tcode-electric-comma)

;;; 文字またはストロークの入れ替え
(global-set-key "\C-t" 'tcode-transpose-strokes-or-chars)
;;; zap-to-charの拡張
(global-set-key "\M-z" 'tcode-zap-to-char)


;;;; 拡張コマンド
(defun toggle-tcode-mode-and-self-insert (arg)
  (interactive "*p")
  (toggle-input-method)
  (self-insert-command arg))

;;; 統計表示
(defun tcode-show-statistics ()
  (interactive)
  (message "chars=%d, bushu=%d, mazegaki=%d, special=%d, nos=%d"
	   tcode-input-chars
	   tcode-bushu-occurrence
	   tcode-mazegaki-occurrence
	   tcode-special-occurrence
	   tcode-number-strokes))

;;; 対応する「」を挿入する。
(defun tcode-insert-matching-pair (left-paren right-paren &optional arg)
  "LEFT-PAREN と RIGHT-PAREN を挿入し、その間にカーソルを移動する。
整数 ARG を指定すると、挿入前のカーソル位置から ARG 文字を
RIGHT-PAREN の前に入れる。この場合、カーソルは RIGHT-PAREN の手前である。"
  (insert left-paren)
  (and arg (tcode-forward-char (prefix-numeric-value arg)))
  (let ((point (point)))
    (insert right-paren)
    (goto-char point)))

;;; 対話的な部首変換
(add-hook 'tcode-ready-hook
	  (function
	   (lambda ()
	     (tcode-set-action-to-table '(5 5)
					'tcode-compose-char-interactively))))

;;; 部首合成変換の確認

(defun tcode-check-bushu-dictionary ()
  (interactive)
  (let ((extend-buffer (get-buffer-create "*extend*"))
	(wrong-buffer (get-buffer-create "*wrong*"))
	(count 0))
    (save-excursion
      (save-excursion
	(set-buffer extend-buffer)
	(erase-buffer)
	(set-buffer wrong-buffer)
	(erase-buffer))
      (goto-char (point-min))
      (while (not (eobp))
	(let* ((entry (tcode-bushu-parse-entry))
	       (str (char-to-string (car entry)))
	       (bushu-list (delq ?\\ (cdr entry))))
	  (if (/= (length bushu-list) 2)
	      (save-excursion
		(set-buffer extend-buffer)
		(insert (mapconcat 'char-to-string entry "") ?\n))
	    (let ((composed (tcode-bushu-compose
			     (car bushu-list)
			     (car (cdr bushu-list)))))
	      (unless (string= (char-to-string composed) str)
		(save-excursion
		  (set-buffer wrong-buffer)
		  (insert (mapconcat 'char-to-string entry "")
			  "[" (or composed "nil")  "]" ?\n)))))
	  (message "%d" (setq count (1+ count)))
	  (forward-line 1))))))

(defun tcode-bushu-selectable-p (decomposed)
  (cond ((null decomposed)
	 nil)
	((stringp (car decomposed))
	 (if (stringp (cdr decomposed))
	     t
	   (tcode-bushu-selectable-p (cdr decomposed))))
	(t
	 (and (tcode-bushu-selectable-p (car decomposed))
	      (if (stringp (cdr decomposed))
		  t
		(tcode-bushu-selectable-p (cdr decomposed)))))))

(defun tcode-check-bushu-help ()
  (interactive)
  (let ((wrong-buffer (get-buffer-create "*wrong*"))
;	(char ?弌))
	(char ?亜))
    (save-excursion
      (set-buffer wrong-buffer)
      (erase-buffer)
;      (while (<= char ?熙)
      (while (<= char ?腕)
	(if (characterp char)
	    (let ((str (char-to-string char)))
	      (message str)
	      (if (not (tcode-stroke-for-char str))
		  (if (not (tcode-bushu-selectable-p
			    (tcode-decompose-char str t)))
		      (if (> (length (tcode-bushu-for-char char)) 1)
			  (insert str ?\n)
			(insert "[" str "]" ?\n))))))
	(setq char (1+ char))))))

;;; 補完の拡張

;; (defun tcode-complete-lookup (prefix)
;;   "補完用辞書からPREFIXを持つ候補を探す。"
;;   (save-excursion
;;     (tcode-set-work-buffer tcode-complete-buffer-name
;; 			   tcode-complete-dictionary-name)
;;     (goto-char (point-min))
;;     (let ((prefix-regexp (concat "^" (regexp-quote prefix)))
;; 	  kouho-list)
;;       (catch 'overflow
;; 	(while (search-forward-regexp prefix-regexp nil t)
;; 	  (beginning-of-line)
;; 	  (let ((kouho (if (looking-at "^.+ \\(.+\\)$")
;; 			   (buffer-substring (match-beginning 1)
;; 					     (match-end 1))
;; 			 (buffer-substring (point)
;; 					   (progn (end-of-line) (point))))))
;; 	    (unless (string= kouho prefix)
;; 	      (setq kouho-list (cons kouho kouho-list))
;; 	      (if (> (length kouho-list) tcode-complete-kouho-max)
;; 		  (throw 'overflow nil))))
;; 	  (forward-line 1))
;; 	(unless kouho-list
;; 	  (setq kouho-list (tcode-mazegaki-complete-lookup prefix)))
;; 	(reverse kouho-list)))))

(defun tcode-mazegaki-complete-lookup (prefix)
  "交ぜ書き辞書からPREFIXを持つ候補を探す。"
  (save-excursion
    (tcode-set-work-buffer tcode-mazegaki-buffer-name
			   tcode-mazegaki-dictionary-name)
    (tcode-mazegaki-search-yomi prefix)
    (let ((prefix-regexp (concat "^" (regexp-quote prefix) ".* /\\(.+\\)/$"))
	  kouho-list)
      (catch 'overflow
	(while (looking-at prefix-regexp nil t)
	  (let ((kouhoes (tcode-split-string-by-regexp
			  (buffer-substring (match-beginning 1)
					    (match-end 1))
			  "/")))
	    (setq kouho-list (nconc kouhoes kouho-list))
	    (if (> (length kouho-list) tcode-complete-kouho-max)
		(throw 'overflow nil))
	    (forword-line 1)
	    (beginning-of-line)))
	(reverse kouho-list)))))

(defun tcode-mazegaki-check-last-yomi ()
  (interactive)
  (let* ((yomi (or (tcode-mazegaki-construct-yomi
		    (+ tcode-mazegaki-current-yomi-length
		       tcode-mazegaki-current-offset))
		   (error "読みがありません")))
	 (ambiguous (save-excursion
		      (tcode-mazegaki-switch-to-dictionary)
		      (goto-char (point-min))
		      (and (re-search-forward
			    (concat "^\\([^ /]+" yomi "\\) /")
			    nil t)
			   (match-string 1)))))
    (if ambiguous
	(message "%s %s" yomi ambiguous)
      (message "OK"))))
;(set-tcode-special-command 1 2 '(tcode-mazegaki-check-last-yomi))

(defun tcode-mazegaki-check-ambiguous-yomi (yomi)
  (save-excursion
    (tcode-mazegaki-switch-to-dictionary)
    (goto-char (point-min))
    (let ((re (concat "^\\([^ /]+" yomi "\\) /"))
	  yomi-list)
      (while (re-search-forward re nil t)
	(setq yomi-list (cons (match-string 1) yomi-list)))
      yomi-list)))

(defun tcode-mazegaki-get-ambiguous-yomi ()
  (interactive)
  (save-excursion
    (tcode-mazegaki-switch-to-dictionary)
    (goto-char (point-min))
    (let (ambiguous-alist yomi)
      (while (looking-at "^\\([^ /]+\\) /")
	(setq yomi (match-string 1))
	(message "%s" yomi)
	(save-excursion
	  (let ((re (concat "^\\([^ /]+" yomi "\\) /"))
		yomi-list)
	    (while (re-search-forward re nil t)
	      (setq yomi-list (cons (match-string 1) yomi-list)))
	    (and yomi-list
		 (setq ambiguous-alist
		       (cons (cons yomi yomi-list) ambiguous-alist)))))
	(forward-line 1))
      ambiguous-alist)))

;;;; 句読点の自動切り替え
(setq tcode-kutouten-regexp-alist
      '(("[、。]" . 1)
	("\\cj[,.]" . 2)
	("[，．]" . 3)))
(setq tcode-auto-identify-kutouten-mode-list
      '(text-mode latex-mode))
(add-hook 'tcode-mode-hook
	  'tcode-auto-switch-kutouten)

;;;;
;;;; EELLL
;;;;

(when (and window-system
	   (not (tcode-xemacs-p)))
  (defvar eelll-frame nil
    "The frame for EELLL.")
  (defvar eelll-frame-parameters nil
    "Parameter of the frame for EELLL.")

  (defun eelll-other-frame ()
    "Make a frame (if need) and run EELLL."
    (interactive)
    (setq eelll-frame (private-frame eelll-frame
				     eelll-frame-parameters
				     'eelll)))

  (define-key ctl-x-5-map [?e] 'eelll-other-frame)
  (global-set-key [?\A-\M-e] 'eelll-other-frame)
  (setq eelll-frame-parameters '((font . "\
-*-fixed-medium-r-normal-*-24-*-*-*-*-*-fontset-24")
				 (top    . 60)
				 (left   . 58)
				 (width  . 80)
				 (height . 27))))

;;; .tc ends here