;;; tc.el --- T-Code frontend for Emacs

;; Copyright (C) 1989--1998 Kaoru Maeda, Yasushi Saito and KITAJIMA Akira.

;; Author: Kaoru Maeda <maeda@src.ricoh.co.jp>
;;	Yasushi Saito <yasushi@cs.washington.edu>
;;      KITAJIMA Akira <kitajima@ics.es.osaka-u.ac.jp>
;; Maintainer: KITAJIMA Akira
;; Version: 2.0 beta 9
;; Keyword: input method

;; $Id: tc.el,v 2.0.9.0 2000/05/13 13:56:46 akira Exp $

;; This program 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 of the License, or
;; (at your option) any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA.

;;; Code:

(require 'tc-sysdep)

;;
;; Version
;;
(defun tcode-version ()
  "T-Code ɥ饤ФΥСɽ롣"
  (interactive)
  (if (interactive-p)
      (message (concat "T-Code driver version "
		       (tcode-version)
		       (if (tcode-xemacs-p)
			   " on XEmacs "
			 " on Emacs ")
		       emacs-version
		       (and (boundp 'nemacs-version)
			    (concat "/NEmacs " nemacs-version))
		       (and (boundp 'mule-version)
			    (concat "/Mule " mule-version))))
    (substring "$Revision: 2.0.9.0 $" 11 -2)))

;;
;; Variables for customization
;;
(defcustom tcode-data-directory (expand-file-name "~/emacs/lisp/")
  "T-Code γƼǡե֤Υǥ쥯ȥꡣ
\"/\"դʤФʤʤ"
  :type 'string :group 'tcode)

(defcustom tcode-bushu-ready-hook nil "Ѵνľ˼¹Ԥ"
  :type 'hook :group 'tcode)
(defvar tcode-bushu-dictionary-name (concat tcode-data-directory "bushu.dic")
  "ѴΥѥ̾")
(defvar tcode-bushu-on-demand 1
  "Ѵ򤤤Ľ뤫
	0 : tc.el ɻ
	1 : T-Code⡼ɤäȤ
	2 : prefixѴ򳫻ϤȤޤʸΥإפ򸫤褦ȤȤ
	3 : postfixѴ򳫻ϤȤ")

(defcustom tcode-use-postfix-bushu-as-default nil
  "* nil ǤʤȤjfpostfixѴԤ77prefixѴԤ
nilλˤϵ" :type 'boolean :group 'tcode)

(defvar tcode-use-egg-in-mazegaki nil
  "򤼽Ѵ򤿤ޤǹԤˤtǹԤˤnilˤ롣")

(unless (featurep 'egg)
  ;; override user preference
  (setq tcode-use-egg-in-mazegaki nil))

(defcustom tcode-use-prefix-mazegaki nil
  "* ַ(跿)θ򤼽Ѵλt, ַ()θ򤼽Ѵλnil

ַǤϡfjϤȡɤϥ⡼ɤꡤ ' 'Ϥ
ѴԤַǤϡfjϤȡݥˤʸȤä
ѴԤ
tcode-use-egg-in-mazegaki nilλˤΤ̣߰ġ"
  :type 'boolean :group 'tcode)

(defvar tcode-self-inserting-commands
  (nconc (cond ((featurep 'egg)
		'((fence-self-insert-command)
		  (egg-self-insert-command . "p")))
	       ((fboundp 'canna-self-insetrt-command)
		'((canna-self-insert-command . "*p"))))
	 '((electric-c-brace . "P")
	   (electric-c-semi . "P")
	   (electric-c-terminator . "P")
	   (c-electric-semi&comma . "P")
	   (electric-perl-terminator . "P"))) "\
tcode-mode ξˤ tcode-self-insert-command ˲Ƥۤޥɤalist
\(command . arg\) η򤷤Ƥ롣
ȤСC⡼ɤ `;'(electric-c-semi)Τ褦ʥޥɤ㡣
arg  interactive ѿƱʸ")

(defvar tcode-alnum-1-to-2-table
  (concat "ɡǡʡˡܡݡ䡩"
	  "£ãģţƣǣȣɣʣˣ̣ͣΣϣУѣңӣԣգ֣ףأ٣ڡΡϡ"
	  "ƣСáѡ")
  "1Хȱѿ ' '..'~' 2ХȱѿѴ/Ѵ뤿Υơ֥")

(defvar tcode-alnum-2-byte-p nil
  "* ѿΥХĹڤ괹ե饰t Ǥ2Хȷϡnil 1Хȷ")
(make-variable-buffer-local 'tcode-alnum-2-byte-p)
(put 'tcode-alnum-2-byte-p 'permanent-local t)

(defvar tcode-kuten "" "* ")
(make-variable-buffer-local 'tcode-kuten)
(put 'tcode-kuten 'permanent-local t)
(defvar tcode-touten "" "* ")
(make-variable-buffer-local 'tcode-touten)
(put 'tcode-touten 'permanent-local t)

(defvar tcode-switch-table-list
  '(((tcode-touten . "")
     (tcode-kuten . ""))

    ((tcode-touten . ", ")
     (tcode-kuten . ". ")))
  "ơ֥ѿͤڤؤ뤿ɽ")

(defvar tcode-stroke-file-name nil "* ȥɽΥѥ̾")
(defvar tcode-table-file-name "tc-tbl" "* Tcodeơ֥ɽΥѥ̾")
(defcustom tcode-record-file-name "~/.tc-record"
  "* non-nil ΤȤT-Codeפ򤳤Υե˵Ͽ"
  :type 'string :group 'tcode)

(defvar tcode-kakutei-register ?\[
  "* 򤼽ѴǺǸ˳ꤷʸ¸Ƥ쥸
nil ξˤ¸ʤ")

(defvar tcode-mode-map nil
  "tcode-mode ΤȤ T-Code ʳΥΤΥޥåס
tcode-keymap-table 򻲾ȡ")

(defcustom tcode-ready-hook nil
  "MuleΩ夲Ƥǽtcode-modeäȤ¹Ԥ"
  :type 'hook :group 'tcode)

(defcustom tcode-mode-hook nil
  "ΥХåեǽtcode-modeäȤ¹Ԥ"
  :type 'hook :group 'tcode)

(defcustom tcode-toggle-hook nil
  "tcode-modeȥ뤹٤˼¹Ԥ"
  :type 'hook :group 'tcode)

(defcustom tcode-after-load-table-hook nil
  "`tcode-load-table' ˤơ֥ɤ߹٤˼¹Ԥ"
  :type 'hook :group 'tcode)

(defcustom tcode-before-read-stroke-hook nil
  "2ȥܰʹߤΥȥɤ˼¹Ԥ"
  :type 'hook :group 'tcode)

(defvar tcode-auto-zap-table nil
  "* non-nil ΤȤ 1 0 ʤɤɽ륹ȥɽ򼡤ǸǼưŪ˾ä")

(defcustom tcode-auto-help t
  "* non-nil ΤȤϤʸΥإɽưŪɽ롣
ɽΤϡ򤼽ѴѴˤäľϤǤ
Τߡ
ޤͤܥ delete-the-char ΤȤϡإפɽ
˺Ǹ˥إפоݤȤʤäʸõ롣

`input-method-verbose-flag'  nil Ǥʤ t Ȥʤ
Τա"
  :group 'tcode)

(defvar tcode-auto-remove-help-count nil
  "* إɽ̵̤ޤǤ˸ƤФ `tcode-auto-remove-help' β
ؿ `tcode-auto-remove-help' ϡѿβƤФȡ
إɽưŪ˺롣nil ξϼưԤʤ")

(defcustom tcode-adjust-window-for-help nil
  "* non-nil ΤȤإפɽ륦ɥ礭ưŪĴ롣"
  :type 'boolean :group 'tcode)

(defcustom tcode-display-help-delay 2
  "* ľʸϤƤ鲾۸פɽޤǤλ()

`input-method-verbose-flag'  nil Ǥʤ 2 Ȥʤ
Τա"
  :group 'tcode)

(defcustom tcode-verbose-message t
  "* non-nil ΤȤ¿Υåɽ롣

`input-method-verbose-flag'  nil Ǥʤ t Ȥʤ
Τա"
  :type 'boolean :group 'tcode)

(defvar tcode-mode-help-string nil
  "`tcode-mode-help' ˤäɽʸ
nil ΤȤ `tcode-mode' 롣")

(defvar tcode-keymap-table
;;   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

;;   1  2  3  4  5  6  7  8  9  0
;;   q  w  e  r  t  y  u  i  o  p
;;   a  s  d  f  g  h  j  k  l  ;
;;   z  x  c  v  b  n  m  ,  .  /

;;      !  \"   #   $   %   &   '   (   )   *   +   ,   -   .   /
;;  0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?
;;  @   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   [   \   ]   ^   _
;;  `   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   {   |   }   ~
  [
   -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  37  -1  38  39
   09  00  01  02  03  04  05  06  07  08  -1  29  -1  -1  -1  -1
   -1  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2
   -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  -1  -1  -1  -1  -1
   -1  20  34  32  22  12  23  24  25  17  26  27  28  36  35  18
   19  10  13  21  14  16  33  11  31  15  30  -1  -1  -1  -1
   ]
  "T-Code ơ֥ɽΰʸϤȤΰ̣ɽ魯
0..39:	T-Code 
-1:	ʸ
-2:	бѾʸ
-3:	tcode-mode-map ˤäޥɡ
< -3:	- (ʸ)")

(unless tcode-mode-map
  (setq tcode-mode-map (make-sparse-keymap))
  (define-key tcode-mode-map "?" 'tcode-mode-help)
  (aset tcode-keymap-table (- ?? ? ) -3)
  (unless tcode-use-egg-in-mazegaki
    ;; tcode-mode ΤȤˡ|פϿѴ
    (define-key tcode-mode-map "|" 'tcode-mazegaki-toroku-and-kakutei)
    (aset tcode-keymap-table (- ?| ? ) -3)
    ;; tcode-mode ΤȤˡ!פǺ
    (define-key tcode-mode-map "!" 'tcode-mazegaki-delete-by-last-yomi)
    (aset tcode-keymap-table (- ?! ? ) -3)
    ;; tcode-mode ΤȤˡ=פ䴰
    (define-key tcode-mode-map "=" 'tcode-mazegaki-complete-and-henkan)
    (aset tcode-keymap-table (- ?= ? ) -3)))

(defvar tcode-no-wait-display-help-command-list
  '(tcode-mazegaki-select-kouho
    tcode-mazegaki-kakutei-and-self-insert)
  "ڡϤǥإɽΥХåեäǽȤʤޥɤΥꥹȡ
ΥꥹΥޥɤǤϡ `tcode-display-help-buffer' ˤ
إפɽ줿ˡ³ƥڡϤȤǤ
إɽϾäʤ")

(defvar tcode-help-window-height-max 21
  "* إפɽ뤿Υɥι⤵κ")

(defvar tcode-ignore-char-list (list ?  ?\t ?\n)
  "ѴʤɤǡѴоݤȤߤʤʤ(̵뤵)ʸΥꥹ")

(defvar tcode-undo-stroke-list '(?\C-\?)
  "ʸϤŪ˼äΥꥹ")
(defvar tcode-verbose-stroke-list '(? )
  "ʸϤǡޤǤϤ򤹤٤ƤΤޤ륭Υꥹ")
(defvar tcode-another-table nil
  "tcode-verbose-stroke-list Υ줿ȤʸΥơ֥롣
ͤ nil ʤФʸvector ǻꤵƤХ˱
ʸ롣")

;;; indicators in modeline
;;; These variables are set in a table file, e.g. tc-tbl.el.
(defvar tcode-transparent-mode-indicator nil)
(defvar tcode-zenkaku-mode-indicator nil)
(defvar tcode-tcode-mode-indicator nil)
(defvar tcode-zenkaku-tcode-mode-indicator nil)
(defvar tcode-hiragana-mode-indicator nil)
(defvar tcode-katakana-mode-indicator nil)

;;
;; Global Variables
;;

;;; ˡ˱Τѿ
(defvar tcode-input-method nil "򤵤Ƥˡ")

;;; ʲѿϡtc-tbl.el ʤɤͤꤵ졢ơ֥
;;; tcode-table ˤƤϿ롣
(defvar tcode-tbl nil)
(defvar tcode-non-2-stroke-char-list nil)
(defvar tcode-special-commands-alist nil)

;;; ϥɤξݻơ֥
(defvar tcode-table nil "ѴѤɽ")
(defvar tcode-stroke-table nil)

;;; ׵ϿѤѿ
(defvar tcode-input-chars 0)
(defvar tcode-number-strokes 0)
(defvar tcode-bushu-occurrence 0)
(defvar tcode-mazegaki-occurrence 0)
(defvar tcode-special-occurrence 0)

(defvar tcode-help-char nil "إפоʸ")
(defvar tcode-self-insert-non-undo-count 0)
(defvar tcode-cancel-undo-boundary-commands nil)
(defvar tcode-auto-remove-help-current-count 0)
(defvar tcode-window-configuration-before-help nil)

(defvar tcode-mode-in-minibuffer nil)

(defconst tcode-bushu-buffer-name " *bushu-dictionary*")
(defconst tcode-stroke-buffer-name " *stroke*")
(defconst tcode-help-buffer-name "*T-Code Help*")

;;; input-method-verbose-flag 
(defvar tcode-input-method-verbose-flag nil)
(defvar tcode-orig-auto-help nil)
(defvar tcode-orig-verbose-message nil)
(defvar tcode-orig-display-help-delay nil)

(defconst tcode-null-map (make-keymap))

;;
;; Buffer Local Variables
;;
(defvar tcode-mode nil "T-Code ⡼ɤΤȤt")
(make-variable-buffer-local 'tcode-mode)
(put 'tcode-mode 'permanent-local t)
(setq-default tcode-mode nil)

(defvar tcode-zenkaku-mode nil
  "ѥ⡼ɤΤȤttcode-mode  t ΤȤΤͭ")
(make-variable-buffer-local 'tcode-zenkaku-mode)
(put 'tcode-zenkaku-mode 'permanent-local t)

(defvar tcode-radicals-max 1)
(defvar tcode-bushu-nest 0 "ѴΥͥȥ٥")
(make-variable-buffer-local 'tcode-bushu-nest)
(put 'tcode-bushu-nest 'permanent-local t)
(defvar tcode-in-mazegaki-p nil "򤼽Ѵ⡼ɤ?")
(make-variable-buffer-local 'tcode-in-mazegaki-p)
(put 'tcode-in-mazegaki-p 'permanent-local t)
(defvar tcode-ready-in-this-buffer nil "ΥХåեT-CodeνOK")
(make-variable-buffer-local 'tcode-ready-in-this-buffer)
(put 'tcode-ready-in-this-buffer 'permanent-local t)
(setq-default tcode-ready-in-this-buffer nil)

(defvar tcode-current-switch-table 0)
(make-variable-buffer-local 'tcode-current-switch-table)
(put 'tcode-current-switch-table 'permanent-local t)
(defvar tcode-katakana-mode nil "ߥʥ⡼ɤɤ")
(make-variable-buffer-local 'tcode-katakana-mode)
(put 'tcode-katakana-mode 'permanent-local t)
(setq-default tcode-katakana-mode nil)

(defvar tcode-use-input-method nil)

;;
;; T-Code main driver
;;

(defun tcode-do-prefix-bushu (list)
  (if (or (<= tcode-bushu-nest 0)
	  (not list))
      list
    (let* ((p (point))
	   (p1 (and (> p 1) (save-excursion (tcode-forward-char -1) (point))))
	   (p2 (and (>= p1 2)
		    (save-excursion (goto-char p1)
				    (tcode-forward-char -1)
				    (point))))
	   kanji
	   (prev-char (and p1 (buffer-substring p1 p)))
	   (prev-prev-char (and p1 p2 (buffer-substring p2 p1))))
      (if (and prev-char prev-prev-char
	       (string-equal prev-prev-char "")
	       (not (string-equal prev-char "")))
	  (progn
	    ;; Ѵ
	    (or tcode-bushu-henkan-last-point
		(setq tcode-bushu-henkan-last-point (point-marker)))
	    (if (setq kanji (tcode-string-to-char
			     (tcode-lookup-outset prev-char (car list))))
		(progn
		  (delete-region p2 p)
		  (setq tcode-bushu-nest (1- tcode-bushu-nest))
		  (tcode-do-prefix-bushu (list kanji)))
	      (beep)
	      (message "")
	      nil))
	(setq tcode-bushu-occurrence (1+ tcode-bushu-occurrence))
	(setq tcode-help-char (car list))
	;; Ѵκ
	list))))

(defun tcode-input-method (key)
  (if input-method-verbose-flag
      (unless tcode-input-method-verbose-flag
	;; push some variables' values
	(setq tcode-orig-auto-help tcode-auto-help
	      tcode-orig-verbose-message tcode-verbose-message
	      tcode-orig-display-help-delay tcode-display-help-delay)
	;; set new values
	(setq tcode-auto-help t
	      tcode-verbose-message t
	      tcode-display-help-delay 2
	      tcode-input-method-verbose-flag t))
    (and tcode-input-method-verbose-flag
	 ;; pop pushed values
	 (setq tcode-auto-help tcode-orig-auto-help
	       tcode-verbose-message tcode-orig-verbose-message
	       tcode-display-help-delay tcode-orig-display-help-delay
	       tcode-input-method-verbose-flag nil)))
  (if (or buffer-read-only
	  (and (boundp 'overriding-terminal-local-map)
	       overriding-terminal-local-map)
	  overriding-local-map)
      (list key)
    (if tcode-zenkaku-mode
	(list (tcode-string-to-char (tcode-1-to-2 (char-to-string key))))
      (setq tcode-number-strokes (1+ tcode-number-strokes))
      (let* (input-method-function	; disable input-method-function
	     (action (tcode-get-action-from-table key))
	     (result (tcode-do-prefix-bushu
		      (cond ((null action)
			     (ding))
			    ((stringp action)
			     (tcode-string-to-char-list action))
			    ((char-or-string-p action)
			     (list action))
			    ((consp action)
			     (mapcar (function
				      (lambda (s) (tcode-string-to-char s)))
				     (delq nil action)))
			    (t
			     (setq tcode-special-occurrence
				   (1+ tcode-special-occurrence))
			     nil)))))
	(if (or (not (char-or-string-p action))
		(stringp action))
	    result
	  (let ((s (mapconcat 'char-to-string
			      result
			      "")))
	    (or (string= s "")
		(tcode-insert s)))
	  nil)))))

(defun tcode-inactivate ()
  "T-Code ⡼ɤ̵ˤ롣"
  (interactive)
  (tcode-activate -1))

(defun tcode-activate (&optional arg)
  "T-Code⡼ɤͭˤ롣ARGΤȤ̵ˤ롣

T-Code ⡼ɤǤ1ȥΥޥɤϰʲΤȤꡣ
\\{tcode-mode-map}
T-Code ⡼ɤˤĤƤϡ\\[tcode-mode-help] ɽإפ򻲾ȡ"
  (if (and arg
	   (< (prefix-numeric-value arg) 0))
      ;; inactivate T-Code mode
      (unwind-protect
	  (progn
	    (if (string-match " \\*Mini" (buffer-name (current-buffer)))
		(setq tcode-mode-in-minibuffer nil))
	    (setq tcode-mode nil)
	    (setq tcode-self-insert-non-undo-count 1)
	    (setq tcode-zenkaku-mode nil)
	    (tcode-clear)
	    (and tcode-in-mazegaki-p
		 (tcode-mazegaki-kakutei))
	    (run-hooks 'input-method-inactivate-hook))
	(kill-local-variable 'input-method-function))
    ;; activate T-Code mode
    (if (string-match " \\*Mini" (buffer-name (current-buffer)))
	(setq tcode-mode-in-minibuffer t))
    (setq tcode-mode t)
    (setq tcode-self-insert-non-undo-count 1)
    (or (featurep 'tcode-ready)
	(tcode-init))
    (or tcode-ready-in-this-buffer
	(tcode-buffer-init))
    (run-hooks 'input-method-activate-hook)
    (make-local-variable 'input-method-function)
    (and tcode-use-input-method
	 (setq input-method-function 'tcode-input-method)))
  (run-hooks 'tcode-toggle-hook)
  (tcode-mode-line-redisplay))

(defun tcode-substitute-command-keys (string)
  "`substitute-command-keys'  `tcode-mode-map' ΤȤŬѤ롣"
  (let ((orig-map (current-local-map)))
    (prog2
	(use-local-map tcode-mode-map)
	(substitute-command-keys string)
      (use-local-map orig-map))))

(defun tcode-init ()
  "MuleưƤǽtcode-modeǼ¹Ԥ롣
ɽ򤼽ѴνԤʤ
tcode-ready-hook Ƥ֡"
  (unless tcode-table
    (tcode-load-table tcode-table-file-name))
  (tcode-bushu-init 1)
  (unless (or (featurep 'egg)
	      tcode-use-input-method)
    (substitute-key-definition 'self-insert-command
			       'tcode-self-insert-command-maybe
			       global-map))
  (provide 'tcode-ready)
  (run-hooks 'tcode-ready-hook)
  (tcode-verbose-message
     (tcode-substitute-command-keys
      "T-Code ⡼ɤǤϡ\\[tcode-mode-help]פǥإפɽޤ")))

(defun tcode-buffer-init ()
  "ХåեȤT-CodeνԤʤtcode-mode-hookƤ֡"
  (unless tcode-ready-in-this-buffer
    (or tcode-use-input-method
	(tcode-substitute-self-insertings))
    (setq tcode-ready-in-this-buffer t)
    (run-hooks 'tcode-mode-hook)))

(defun tcode-on-p ()
  "Return tcode-mode or tcode-mode-in-minibuffer according to current buffer."
  (if (string-match " \\*Mini" (buffer-name (current-buffer)))
      tcode-mode-in-minibuffer
    tcode-mode))

(defun tcode-mode-line-redisplay ()
  (setq current-input-method-title
	(if (tcode-on-p)
	    (if tcode-zenkaku-mode
		tcode-zenkaku-mode-indicator
	      (concat (if tcode-alnum-2-byte-p
			  tcode-zenkaku-tcode-mode-indicator
			tcode-tcode-mode-indicator)
		      (if tcode-katakana-mode
			  tcode-katakana-mode-indicator
			tcode-hiragana-mode-indicator)))
	  tcode-transparent-mode-indicator))
  (if tcode-egg-mode-line
      (mode-line-egg-mode-update current-input-method-title)
    (and (string-match " \\*Mini" (buffer-name (current-buffer)))
	 (boundp 'minibuffer-preprompt)
	 (setq minibuffer-preprompt
	       (list "[" (eval tcode-mode-indicator) "]")))
    (set-buffer-modified-p (buffer-modified-p))))

(defun tcode-substitute-self-insertings ()
  "tcode-self-inserting-commands ˥ꥹȤƤ륳ޥɤ̵롣
δؿfuncϡorig:funcȤ̾Ѥ롣
ơfuncϡT-Code⡼ǤϡT-CodeʸϤ򡤥⡼ɳǤ
orig:funcƤӽФؿ֤롣"
  (let ((commands tcode-self-inserting-commands)
	com symbol havearg tcode-func orig-func)
    (while commands
      (setq com (car commands)
	    commands (cdr commands)
	    symbol (car com)
	    havearg (cdr com)
	    tcode-func (intern (concat "tcode:" (symbol-name symbol)))
	    orig-func (intern (concat "orig:" (symbol-name symbol))))
      (when (and (not (fboundp tcode-func))
		 (fboundp symbol))
	(fset orig-func (symbol-function symbol))
	(eval (list 'defun tcode-func (if havearg '(arg))
		    (documentation orig-func)
		    (cons 'interactive (if havearg (list havearg)))
		    (list 'if 'tcode-mode '(tcode-self-insert-command)
			  (cons orig-func (if (cdr com) '(arg))))))
	(fset symbol tcode-func)))))

(defun tcode-cancel-undo-boundary ()
  "ʸȤˡޤȤ undo Ǥ褦Ĵ롣"
  (if (or (not (memq last-command
		     (if (memq this-command
			       tcode-cancel-undo-boundary-commands)
			 tcode-cancel-undo-boundary-commands
		       (setq tcode-cancel-undo-boundary-commands
			     (cons this-command
				   tcode-cancel-undo-boundary-commands)))))
	  (>= tcode-self-insert-non-undo-count 20))
      (setq tcode-self-insert-non-undo-count 1)
    (cancel-undo-boundary)
    (setq tcode-self-insert-non-undo-count
	  (1+ tcode-self-insert-non-undo-count))))

(defun tcode-self-insert-command-maybe (arg)
  (interactive "p")
  (if (tcode-on-p)
      (tcode-self-insert-command arg)
    (tcode-cancel-undo-boundary)
    (self-insert-command arg)))

(defun tcode-exit-minibuffer ()
  (interactive)
  (setq tcode-mode nil
	tcode-zenkaku-mode nil
	tcode-mode-in-minibuffer nil)
  (and (boundp 'minibuffer-preprompt)
       (setq minibuffer-preprompt nil)))

(defun tcode-clear (&optional help-also)
  "䤳⡼ɤäƤΤꥢ"
  (interactive)
  (if (not (tcode-on-p))
      (tcode-auto-remove-help)
    ;; tcode on
    (while (< 0 tcode-bushu-nest)
      (tcode-end-bushu))
    (and tcode-in-mazegaki-p
	 (tcode-mazegaki-kakutei))
    (and help-also
	 (tcode-auto-remove-help t))))

(defun tcode-function-p (obj)
  (cond ((or (null obj)
	     (arrayp obj))
	 nil)
	((symbolp obj)
	 (fboundp obj))
	((consp obj)
	 (eq (car obj) 'lambda))
	(t
	 nil)))

(defun tcode-encode-sequence (sequence table)
  (cond ((or (null table)
	     (null sequence))
	 table)
	((consp table)
	 (tcode-encode-sequence (cdr sequence) (assq (car sequence) table)))
	((vectorp table)
	 (tcode-encode-sequence (cdr sequence) (aref table (car sequence))))
	(t
	 (error "bad data structure"))))

(defun tcode-action-to-printable (action)
  (cond ((or (null action)
	     (stringp action))
	 action)
	((char-or-string-p action)
	 (char-to-string action))
	((and (symbolp action)
	      (boundp action))
	 (tcode-action-to-printable (eval action)))
	(t
	 "*")))

(defun tcode-encode-key (k1 k2 c1 c2)
  "Encode the 1st Tcode stroke(K1) and 2nd stroke(K2) to a Kanji character."
  (if (or (< k1 0) (< k2 0))
      (concat (char-to-string c1)
	      (if (= c2 ?\ )
		  ""
		(char-to-string c2)))
    (tcode-action-to-printable (tcode-encode-sequence (list k1 k2)
						      tcode-table))))

(defun tcode-set-action-to-table (sequence value)
  "Ѥơ֥ SEQUENCE Ф VALUE ꤹ롣
ư(VALUE)ȤƻǤΤϰʲΤȤꡣ
    - ޥ (symbol)		Υޥɤ¹Ԥ롣
    - ؿ (symbol, lambda)	δؿʤǸƤ֡
    - ѿ (symbol)		ɾ̤ưԤ
    - ɽ (vector)		ˤɽ˽äưԤ
    - ꥹ (list)		ˤΥꥹȤ˽äưԤ
    - ʸ (string)		ʸ롣
    - ʸ (char)		ʸ롣

  ϥϤΥꥹȤޤϥϡ
ϤꤹȡǸ SPC 򲡤Ȥưꤹ롣"
  (cond ((consp sequence)
	 (tcode-set-action tcode-table sequence value))
	((and (char-or-string-p sequence)
	      (not (stringp sequence)))
	 (and (null tcode-another-table)
	      (setq tcode-another-table (make-vector 40 nil)))
	 (aset tcode-another-table sequence value))
	(t
	 (error "λ̵꤬Ǥ"))))

(defun tcode-set-action (table sequence value)
  "TABLE Ρ SEQUENCE  VALUE ꤹ롣"
  (let ((key (car sequence))
	(subsequence (cdr sequence))
	(subsubsequence (nthcdr 2 sequence)))
    (cond (subsubsequence
	   (tcode-set-action (if (consp table)
				 (cdr (assq key table))
			       (aref table key))
			     subsequence
			     value))
	  (subsequence
	   (cond ((or (and (char-or-string-p table)
			   (not (stringp table)))
		      (null table))
		  (list key (tcode-set-action nil subsequence value)))
		 ((vectorp table)
		  (aset table key
			(tcode-set-action (aref table key) subsequence value))
		  table)
		 (t
		  (let ((orig table))
		    (while (and table
				(/= (car (car table)) key))
		      (setq table (cdr table)))
		    (if (null table)
			(nconc orig
			       (list (list key
					   (tcode-set-action
					    nil subsequence value))))
		      (setcdr (car table)
			      (tcode-set-action (cdr (car table))
						subsequence
						value))
		      table)))))
	  (t
	   ;; add key
	   (if (listp table)
	       (cond ((null table)
		      (cons key value))
		     ((and (char-or-string-p (car table))
			   (not (stringp (car table)))
			   (not (consp (cdr table))))
		      (list table (cons key value)))
		     (t
		      (let ((old (assq key table)))
			(while old
			  (setq table (delq old table)
				old (assq key table)))
			(if (null table)
			    (cons key value)
			  (nconc (list (cons key value)) table)))))
	     (if (vectorp table)
		 (progn
		   (aset table key value)
		   table)
	       (list (cons key value))))))))

(defun tcode-get-action (c table &optional not-exec)
  "ʸ C Ȥơɽ TABLE 鳵ư롣
NOT-EXEC  nil ǤʤСưޥɤؿäǤ⡢
¹Ԥʤ"
  (let ((key (tcode-get-key-address c)))
    (if (< key 0)
	;; C is not a key on TABLE
	(cond ((memq c tcode-undo-stroke-list)
	       t)
	      ((memq c tcode-verbose-stroke-list)
	       (list nil))
	      (t
	       (tcode-get-action-from-table c not-exec)))
      ;; C is a key on TABLE
      (let ((rval (tcode-read-strokes (if (consp table)
					  (cdr (assq key table))
					(aref table key))
				      not-exec)))
	(cond ((and tcode-katakana-mode
		    (stringp rval))
	       (tcode-hiragana-to-katakana-string rval))
	      ((and tcode-katakana-mode
		    (char-or-string-p rval))
	       (tcode-hiragana-to-katakana-char rval))
	      ((or (null rval)
		   (eq rval t)
		   (char-or-string-p rval)
		   (tcode-function-p rval)) ; commandp also
	       rval)
	      ((listp rval)
	       (if (and tcode-another-table
			(>= key 0)
			(< key 40))
		   (let ((new-rval (aref tcode-another-table key)))
		     (if (null new-rval)
			 (cons (char-to-string c) rval)
		       (tcode-read-strokes new-rval not-exec)))
		 (cons (char-to-string c) rval))))))))

(defun tcode-get-action-from-table (c &optional not-exec)
  "`tcode-table' 줿ʸ C ϤޤưŪ롣"
  (let ((key (tcode-get-key-address c)))
    (if (< key 0)
	(cond ((= key -1)
	       (if (and (<= ?  c) (<= c ?~))
		   c
		 (if not-exec
		     (list 'lambda nil (list 'tcode-do-command c))
		   (tcode-redo-command c)
		   t)))
	      ((= key -2)
	       (downcase c))
	      ((= key -3)
	       (if not-exec
		   (list 'lambda nil (list 'tcode-do-command c))
		 (let ((save-local-map (current-local-map))
		       (save-global-map (current-global-map))
		       keyseq command)
		   (tcode-redo-command c)
		   (unwind-protect
		       (progn
			 (use-local-map tcode-mode-map)
			 (use-global-map tcode-null-map)
			 (setq keyseq (read-key-sequence nil))
			 (setq command (key-binding keyseq)))
		     (use-local-map save-local-map)
		     (use-global-map save-global-map))
		   (if (null command)
		       (ding)
		     (setq prefix-arg current-prefix-arg
			   this-command command)
		     (command-execute command))
		   t)))
	      (t
	       (- key)))
      ;; C is on table
      (tcode-get-action c tcode-table not-exec))))

(defun tcode-draw-current-table (table)
  "TABLE 顢Ϥˤʸɽɽ"
  (tcode-draw-table
   (if (vectorp table)
       (let ((draw-table (copy-sequence table))
	     (i 0))
	 (while (< i 40)
	   (aset draw-table i (tcode-action-to-printable (aref draw-table i)))
	   (setq i (1+ i)))
	 draw-table)
     ;; table ϥꥹ
     (let ((draw-table (make-vector 40 nil)))
       (while table
	 (let ((elm (car table)))
	   (aset draw-table (car elm) (tcode-action-to-printable (cdr elm)))
	   (setq table (cdr table))))
       draw-table))
   1 1))

(defun tcode-read-strokes (table &optional not-exec)
  "TABLE η˱ơȥɤࡣ"
  (cond ((null table)			; nil
	 nil)
	((char-or-string-p table)	; ʸޤʸ
	 table)
	((and (not (consp table))
	      (not (arrayp table))
	      (commandp table))		; ޥ
	 (if not-exec
	     table
	   (call-interactively table)
	   t))
	((tcode-function-p table)	; ޥɤǤʤؿ
	 (if not-exec
	     table
	   (funcall table)
	   t))
	((or (consp table)		; ꥹȤޤ
	     (vectorp table))		; 
	 (setq tcode-number-strokes (1+ tcode-number-strokes))
	 (run-hooks 'tcode-before-read-stroke-hook)
	 (let ((show-table (sit-for tcode-display-help-delay)))
	   (unwind-protect
	       (let ((echo-keystrokes 0))
		 (and show-table
		      (tcode-display-help-buffer
		       (tcode-draw-current-table table)
		       t))
		 (condition-case nil
		     (tcode-get-action (read-char) table not-exec)
		   (t t)))
	     (and show-table
		  (tcode-auto-remove-help t)))))
	((boundp table)			; ѿ
	 (tcode-read-strokes (eval table)))
	(t				; ¾
	 nil)))

(defun tcode-self-insert-command (&optional arg)
  "Encode Tcode character and insert."
  (interactive)
  (if (and tcode-use-egg-in-mazegaki
	   (not buffer-read-only)
	   mc-flag
	   egg:*mode-on* egg:*input-mode*
	   (not (and (current-local-map)
		     (eq (current-local-map) fence-mode-map)))
	   (not egg:*in-fence-mode*)	; inhibit recursive fence mode
	   (/= last-command-char  ?  ))
      (egg:enter-fence-mode-and-self-insert)
    (let ((s (mapconcat 'char-to-string
			(delq nil (tcode-input-method last-command-char))
			"")))
      (or (string= s "")
	  (tcode-insert s)))))

(defvar tcode-bushu-henkan-last-point nil
  "Ѵ򳫻ϤΥݥȰ")

(defun tcode-insert (ch)
  "CHХåե롣"
  (unless (stringp ch)
    (setq ch (char-to-string ch)))
  (setq tcode-input-chars (1+ tcode-input-chars))
  (setq tcode-help-char ch)
  (let* ((p (point))
	 (arg (prefix-numeric-value current-prefix-arg))
	 (n (if (consp current-prefix-arg)
		(/ (car current-prefix-arg) 2)
	      arg)))
    (if (and tcode-alnum-2-byte-p
	     (= 1 (length ch)))
	(setq ch (tcode-1-to-2 ch)))
    (if (= 1 (length ch))
	;; ascii iso8859-1ξ
	(let ((last-command-char (aref ch 0)))
	  (setq this-command 'self-insert-command)
	  (self-insert-command n))
      (if (and (not (tcode-nemacs-p))
	       (= (chars-in-string ch) 1))
	  (let ((last-command-char (string-to-char ch)))
	    (self-insert-command n))
	(while (> n 0)
	  (insert ch)
	  (setq n (1- n))))
      (unless tcode-in-mazegaki-p
	(and (boundp 'egg-insert-after-hook)
	     egg-insert-after-hook
	     (run-hooks 'egg-insert-after-hook))
	(if overwrite-mode
	    (let ((str (buffer-substring p (point))))
	      (delete-text-in-column nil (+ (current-column)
					    (string-width str)))))
	(if (and (boundp 'self-insert-after-hook)
		 self-insert-after-hook)
	    (funcall self-insert-after-hook p (point)))
	(tcode-do-auto-fill)
	(run-hooks 'input-method-after-insert-chunk-hook))))
  (and (markerp tcode-bushu-henkan-last-point)
       (set-marker tcode-bushu-henkan-last-point nil))
  (setq tcode-bushu-henkan-last-point nil))

(defun tcode-insert-register (reg arg)
  "insert-register ƱݥȤȥޡΰ֤ա"
  (interactive "cInsert register: \nP")
  (insert-register reg (not arg)))

;;
;; Egg patches
;;

(when (featurep 'egg)
  (defun tcode-fence-exit-mode ()
    (interactive)
    (fence-exit-mode)
    (tcode-egg-exit))

  (defun tcode-henkan-kakutei ()
    (interactive)
    (henkan-kakutei)
    (tcode-egg-exit))

  (defun tcode-egg-exit ()
    (setq egg:*mode-on* nil
	  egg:*in-fence-mode* nil)
    (setq tcode-in-mazegaki-p nil)
    (tcode-mode-line-redisplay))

  (substitute-key-definition 'fence-exit-mode
			     'tcode-fence-exit-mode
			     fence-mode-map)
  (substitute-key-definition 'henkan-kakutei
			     'tcode-henkan-kakutei
			     henkan-mode-map))

;;
;; Help
;;
(defun tcode-verbose-message (message &optional non-verbose-message)
  "ѿ `tcode-verbose-message'  non-nil ξˤϡ MESSAGE ɽ롣
ǤʤȤ NON-VERBOSE-MESSAGE Сɽ롣"
  (if (or tcode-verbose-message
	  non-verbose-message)
      (message (if tcode-verbose-message message non-verbose-message))))

(defun tcode-format-list (param list)
  "PARAM ˽äʸΥꥹ LIST Ĥʤ롣
PARAM ˻ǤΤϡʸȿǡ LIST Ǥ
ɽ뤫ɽ"
  (let (line)
    (while param
      (let ((elm (car param)))
	(cond ((stringp elm)
	       (setq line (concat line elm)))
	      ((integerp elm)
	       (let* ((str (car list))
		      (width (let ((sum 0))
			       (mapcar
				(function
				 (lambda (c)
				   (setq sum (+ sum (tcode-char-width c)))))
				(tcode-string-to-char-list str))
			       sum))
		      (pad-width (- (abs elm) width))
		      (pad (if (> pad-width 0)
			       (make-string pad-width ? )
			     "")))
		 (setq line (if (< elm 0)
				(concat line str pad)
			      (concat line pad str))
		       list (cdr list))))))
      (setq param (cdr param)))
    line))

(defconst tcode-table-line-format-1
  '(" " -5 -5 -5 -5 " " -5 " " 5 " " 5 5 5 5 "\n"))
(defconst tcode-table-line-format-2
  '("[" -5 -5 -5 -4 "] " -5 "  " 4 " [" 4 5 5 5 "]\n"))

(defun tcode-draw-table (table page whole-page)
  "ɽ TABLE ˴ŤɽϤʤ"
  (let ((buf (get-buffer-create " *tcode-table*")))
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (mapcar
       (function
	(lambda (key-list)
	  (let ((kouho-list (mapcar
			     (function (lambda (n) (or (aref table n) "-")))
			     key-list)))
	    (insert
	     (tcode-format-list
	      (if (= (car key-list) 0)
		  tcode-table-line-format-1
		tcode-table-line-format-2)
	      kouho-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)))
      (unless (= whole-page 1)
	(backward-char 1)
	(insert (format "     (%d/%d)" page whole-page))))
    buf))

(defun tcode-display-help-buffer (buffer &optional display-only append)
  "\"*T-Code Help*\" ȤХåե BUFFER Ƥɽ롣
ɽľ˶Ϥȡ DISPLAY-ONLY  nil ʤФΥХåե
õ롣 APPEND  nil ǤʤȤϡƤɲäɽ롣"
  ;; ɥ¸
  (unless (get-buffer-window tcode-help-buffer-name)
    (setq tcode-window-configuration-before-help
	  (if (one-window-p)
	      nil
	    (current-window-configuration))))
  ;; ɽƤɽ
  (let (previous-contents)
    (and append
	 (let ((buf (get-buffer tcode-help-buffer-name)))
	   (setq previous-contents (and buf
					(save-excursion
					  (set-buffer buf)
					  (buffer-string))))))
    (with-output-to-temp-buffer tcode-help-buffer-name
      (when previous-contents
	(princ previous-contents)
	(princ "\n"))
      (princ (save-excursion (set-buffer buffer) (buffer-string))))
    (if (fboundp 'help-mode)
	(save-excursion
	  (set-buffer (get-buffer tcode-help-buffer-name))
	  (help-mode))))
  ;; ɥ礭Ĵ
  (let ((orig-win (selected-window))
	(new-win (get-buffer-window tcode-help-buffer-name))
	(window-min-height 2))
    (when new-win
      (select-window new-win)
      (if (and (or (not tcode-window-configuration-before-help)
		   tcode-adjust-window-for-help)
	       (= (frame-width) (window-width)))
	  (enlarge-window (- (1+ (min (count-lines (point-min) (point-max))
				      tcode-help-window-height-max))
			     (window-height))))
      (set-window-start (selected-window) (point-min))
      (or (one-window-p)
	  (select-window orig-win))))
  ;; ɽν
  (setq tcode-auto-remove-help-current-count 0)
  (unless (or display-only
	      (memq this-command tcode-no-wait-display-help-command-list))
    (tcode-verbose-message "ڡǥإפäޤ" " ")
    (let ((ch (read-char)))
      (if (/= ch ? )
	  (tcode-redo-command ch)
	(tcode-auto-remove-help t))
      (message ""))))

(defun tcode-auto-remove-help (&optional immediate)
  "إפưŪ˾õ롣
õΤϡإפɽƤ
δؿ `tcode-auto-remove-help-count' ƤФ줿Ȥ"
  (when (or immediate
	    (and tcode-auto-remove-help-count
		 (>= (setq tcode-auto-remove-help-current-count
			   (1+ tcode-auto-remove-help-current-count))
		     tcode-auto-remove-help-count)))
    (let ((help-buf (get-buffer tcode-help-buffer-name))
	  help-win)
      (and help-buf
	   (not (eq help-buf (current-buffer)))
	   (setq help-win (get-buffer-window help-buf))
	   (cond (tcode-window-configuration-before-help
		  (let ((orig-win (selected-window))
			(orig-buf (current-buffer))
			(orig-pos (point)))
		    (and tcode-adjust-window-for-help
			 (set-window-configuration
			  tcode-window-configuration-before-help))
		    (or (one-window-p)
			(select-window orig-win))
		    (set-window-buffer (selected-window) orig-buf)
		    (goto-char orig-pos)))
		 ((not (one-window-p))
		  (delete-window help-win))))
      (and help-buf
	   (not (eq help-buf (current-buffer)))
	   (kill-buffer help-buf)))))

;;
;; JIS
;;

(defvar tcode-jiscode-buffer " *jis-code*")
(defvar tcode-jiscode-window-configuration nil)
(defvar tcode-jiscode-marker nil)

(defvar tcode-jiscode-map nil)
(unless tcode-jiscode-map
  (setq tcode-jiscode-map (make-sparse-keymap))
  (mapcar
   (function
    (lambda (elm)
      (let ((cmd (car elm))
	    (key (cdr elm)))
	(if (listp key)
	    (while key
	      (define-key tcode-jiscode-map (car key) cmd)
	      (setq key (cdr key)))
	  (define-key tcode-jiscode-map key cmd)))))
   '((digit-argument       . ("0" "9" "8" "7" "6" "5" "4" "3" "2" "1" "-"))
     (previous-line        . ("k" "p"))
     (next-line            . ("j" "n"))
     (backward-char        . ("h" "b"))
     (forward-char         . ("l" "f"))
     (scroll-down          . "\C-?")
     (scroll-up            . " ")
     (tcode-jiscode-quit   . "q")
     (tcode-jiscode-insert . ("\n" "\r"))
     (describe-mode        . "?"))))

(defun tcode-jiscode-quit ()
  "JIS ɽϥ⡼ɤλ롣"
  (interactive)
  (set-window-configuration tcode-jiscode-window-configuration)
  (goto-char tcode-jiscode-marker)
  (setq tcode-jiscode-window-configuration nil
	tcode-jiscode-marker nil))

(defun tcode-jiscode-insert-line (1st 2nd)
  (insert (format "%02x%02x " (- 1st 128) (- 2nd 128)))
  (let ((i 0))
    (while (and (< i 16) (< 2nd 255))
      (insert (char-to-string (make-character lc-jp 1st 2nd)))
      (setq 2nd (1+ 2nd))
      (setq i (1+ i)))
    (insert " : ")
    (while (and (< i 32)(< 2nd 255))
      (insert (char-to-string (make-character lc-jp 1st 2nd)))
      (setq 2nd (1+ 2nd))
      (setq i (1+ i))))
  (insert ":\n"))

(defun tcode-jiscode-insert-tables ()
  "JISɽä, Хåե. "
  (message "Making jiscode tables...")
  (let ((1st 161) (2nd 161))
    (while (< 1st 255)
      (setq 2nd 161)
      (tcode-jiscode-insert-line 1st 2nd)
      (tcode-jiscode-insert-line 1st (+ 2nd 32))
      (tcode-jiscode-insert-line 1st (+ 2nd (* 2 32)))
      (setq 1st (1+ 1st))))
  (message "Making jiscode tables...done.")
  (beginning-of-buffer))

(defun tcode-jiscode-insert ()
  "JIS ɽθ֤߰ˤʸɽˤХåե롣"
  (interactive)
  (let ((str (buffer-substring (point)
			       (save-excursion
				 (tcode-forward-char 1)
				 (point)))))
    (set-buffer (marker-buffer tcode-jiscode-marker))
    (tcode-insert str)
    (setq tcode-jiscode-marker
	  (move-marker tcode-jiscode-marker (point)))))

(defun tcode-start-jiscode ()
  "JISɽХåե*jis-code*ɽ롣
ɽ줿ХåեǤϡŪ˴ǸΥХåեǤ롣
  *jis-code*ǻȤ륭ϼ̤:

   \\[tcode-jiscode-insert]\t֤δХåե.
   \\[tcode-jiscode-quit]\tХåեˤɤ.

\\{tcode-jiscode-map}"
  (interactive)
  (setq tcode-jiscode-marker (point-marker))
  (or (get-buffer-window tcode-jiscode-buffer)
      (setq tcode-jiscode-window-configuration
	    (current-window-configuration)))
  (switch-to-buffer-other-window tcode-jiscode-buffer)
  (if (= (point-min) (point-max))
      (progn
	(tcode-jiscode-insert-tables)
	(setq mode-name "JIS-select")
	(use-local-map tcode-jiscode-map)
	(setq major-mode 'tcode-start-jiscode)
	(setq buffer-read-only t)))
  (tcode-verbose-message "? ǥإ"))


;;
;; 򤼽񤭼
;;

(defun tcode-kill-emacs-function ()
  (and (fboundp 'tcode-save-jisyo)
       (tcode-save-jisyo))
  (tcode-record))

(add-hook 'kill-emacs-hook 'tcode-kill-emacs-function)

(defun tcode-record ()
  (and tcode-record-file-name
       (> tcode-number-strokes 0)
       (save-excursion
	 (set-buffer (get-buffer-create " *record*"))
	 (erase-buffer)
	 (insert
	  (format (concat "%s  ʸ: %4d  : %3d(%d%%)  "
			  "򤼽: %3d(%d%%)  ǽ: %3d(%d%%)\n")
		  (let ((time (current-time-string)))
		    (if (not (string-match "^... \\(.*:.*\\):" time))
			""
		      (substring time (match-beginning 1) (match-end 1))))
		  tcode-input-chars
		  tcode-bushu-occurrence
		  (/ (* 100 tcode-bushu-occurrence) tcode-number-strokes)
		  tcode-mazegaki-occurrence
		  (/ (* 100 tcode-mazegaki-occurrence) tcode-number-strokes)
		  tcode-special-occurrence
		  (/ (* 100 tcode-special-occurrence) tcode-number-strokes)))
	 (append-to-file (point-min) (point-max) tcode-record-file-name))))

;;
;; TcodeΥơ֥ɽ
;;
(defun tcode-switch-variable (&optional arg)
  "(`tcode-table' ) ѿͤڤؤ롣
ڤؤѿȤͤ `tcode-switch-table-list' ǻꤹ롣
ARG  nil ǤʤȤARG ܤȤڤؤ롣"
  (interactive "P")
  (message
   (mapconcat
    'identity
    (mapcar
     (function (lambda (elm)
		 (set (car elm) (cdr elm))))
     (progn
       (setq tcode-current-switch-table
	     (if arg
		 (1- (prefix-numeric-value arg))
	       (1+ tcode-current-switch-table)))
       (let ((table (nth tcode-current-switch-table
			 tcode-switch-table-list)))
	 (and (null table)
	      (setq tcode-current-switch-table 0
		    table (car tcode-switch-table-list)))
	 table)))
    "")))

(defun tcode-replace-part-of-table (table)
  "`tcode-table' ΰ TABLE ֤롣
TABLE ϥΥꥹȤȤư alist"
  (mapcar
   (function (lambda (elm)
	       (tcode-set-action tcode-table (car elm) (cdr elm))))
   table))

;;;###autoload
(defun tcode-load-table (filename)
  (interactive "fLoad T-Code table file: ")
  (let ((k1 0) k2 newval char)
    (load filename)
    (setq tcode-table (make-vector 40 nil))
    (while (< k1 40)
      (aset tcode-table k1 (make-vector 40 nil))
      (setq k1 (1+ k1)))
    (setq k1 0)
    (while (< k1 40)
      (let ((v (aref tcode-tbl k1)))
	(if (null v)
	    ()
	  (setq newval (vconcat (delq ?  (tcode-string-to-char-list v))))
	  (or (= (length newval) 40)
	      (error "Table corrupted at line %d." (1+ k1)))
	  (setq k2 0)
	  (while (< k2 40)
	    (or (memq (setq char (aref newval k2))
		      tcode-non-2-stroke-char-list)
		(aset (aref tcode-table k2) k1 char))
	    (setq k2 (1+ k2)))))
      (setq k1 (1+ k1)))
    (setq tcode-tbl nil)		; free
    ;; ޥɤơ֥Ͽ롣
    (tcode-replace-part-of-table tcode-special-commands-alist)
    (setq tcode-special-commands-alist nil) ; free
    ;; 'stroke property 롣
    (setq tcode-stroke-table (make-vector 511 nil))
    (tcode-set-stroke-property tcode-table nil)
    (and (get-buffer tcode-stroke-buffer-name)
	 (kill-buffer tcode-stroke-buffer-name))
    (run-hooks 'tcode-after-load-table-hook)
    (tcode-clear)
    (tcode-mode-line-redisplay)))

(defun tcode-set-stroke-property (table sequence)
  (cond ((or (null table)
	     (tcode-function-p table)))
	((stringp table)
	 (put (intern table tcode-stroke-table)
	      'stroke
	      (vconcat sequence)))
	((char-or-string-p table)
	 (put (intern (char-to-string table) tcode-stroke-table)
	      'stroke
	      (vconcat sequence)))
	((consp table)
	 (while table
	   (tcode-set-stroke-property (cdr (car table))
				      (append sequence
					      (list (car (car table)))))
	   (setq table (cdr table))))
	((vectorp table)
	 (let ((i 0))
	   (while (< i 40)
	     (tcode-set-stroke-property (aref table i)
					(append sequence (list i)))
	     (setq i (1+ i)))))
	((and (symbolp table)
	      (boundp table))
	 (tcode-set-stroke-property (eval table) sequence))))

(defun tcode-stroke-for-char (ch)
  "CHǤꥹȤ֤ľϤǤʤnil֤"
  (append (get (intern-soft ch tcode-stroke-table) 'stroke) nil))

(defun tcode-transpose-strokes (arg)
  "ݥȰ֤ʸΥȥ줫"
  (interactive "*P")
  (if (not (tcode-on-p))
      (transpose-chars arg)
    (if (eolp) (tcode-forward-char -1))
    (let* ((ch (buffer-substring (point)
				(save-excursion (tcode-forward-char 1)
						(point))))
	   (stroke (tcode-stroke-for-char ch)))
      (when (and (= (length stroke) 2)
		 (setq ch (tcode-action-to-printable
			   (tcode-encode-sequence (reverse stroke)
						  tcode-table))))
	(tcode-delete-char 1)
	(insert ch)))))

(defun tcode-unmap-key (c)
  "ֹ椫бʸ롣"
  (let ((max (length tcode-keymap-table))
	(i 0))
    (catch 'found
      (while (< i max)
	(and (= c (aref tcode-keymap-table i))
	     (throw 'found t))
	(setq i (1+ i))))
    (+ i ? )))

(defun tcode-get-key-address (c)
  (if (or (< c ? ) (> c ?~))
      -1
    (aref tcode-keymap-table (- c ? ))))


;;
;; 2-byte ѿ
;;
(defvar tcode-alnum-2byte-regexp nil)

(defun tcode-check-alnum-1-to-2-table ()
  (if (stringp tcode-alnum-1-to-2-table)
      (setq tcode-alnum-1-to-2-table
	    (vconcat (tcode-string-to-char-list tcode-alnum-1-to-2-table))
	    tcode-alnum-2byte-regexp nil))
  (if (null tcode-alnum-2byte-regexp)
      (setq tcode-alnum-2byte-regexp
	    (concat "["
		    (mapconcat 'char-to-string
			       tcode-alnum-1-to-2-table "")
		    "]+"))))

(defun tcode-1-to-2-region (beg end)
  "꡼1Хȱѿ2ХȤѴ"
  (interactive "*r")
  (tcode-check-alnum-1-to-2-table)
  (let (char)
  (save-excursion
    (save-restriction
      (goto-char beg)
      (narrow-to-region beg end)
      (while (progn (skip-chars-forward "^!-~" (point-max))
		    (< (point) (point-max)))
	(setq char (following-char))
	(tcode-delete-char 1)
	(insert (tcode-1-to-2 char)))))))

(defun tcode-1-to-2 (str)
  "STR 1Хȱѿ2ХȤѴ롣
STR ʸǤä餽2ХȤѴʸ֤"
  (tcode-check-alnum-1-to-2-table)
  (cond ((and (char-or-string-p str)
	      (not (stringp str)))
	 (if (and (<= ?! str) (<= str ?~))
	     (char-to-string (aref tcode-alnum-1-to-2-table (- str ? )))
	   (char-to-string str)))
	((= 1 (length str))
	 (tcode-1-to-2 (aref str 0)))
	(t
	 (mapconcat 'tcode-1-to-2 (tcode-string-to-char-list str) ""))))

(defun tcode-2-to-1-region (beg end)
  "꡼2Хȱѿ1ХȤѴ"
  (interactive "*r")
  (tcode-check-alnum-1-to-2-table)
  (save-excursion
    (save-restriction
      (let (str)
	(goto-char beg)
	(narrow-to-region beg end)
	(while (re-search-forward tcode-alnum-2byte-regexp nil t)
	  (setq str (buffer-substring (match-beginning 0) (match-end 0)))
	  (delete-region (match-beginning 0) (match-end 0))
	  (insert (tcode-2-to-1 str)))))))

(defun tcode-2-to-1 (str)
  "STR 2Хȱѿ1ХȤѴ"
  (tcode-check-alnum-1-to-2-table)
  (cond ((and (char-or-string-p str)
	      (not (stringp str)))
	 (char-to-string
	  (let ((ch 0))
	    (catch 'found
	      (while (< ch 95)
		(if (= (aref tcode-alnum-1-to-2-table ch) str)
		    (throw 'found (+ ch 32)))
		(setq ch (1+ ch)))
	      str))))
	(t
	 (mapconcat 'tcode-2-to-1 (tcode-string-to-char-list str) ""))))

;;;
;;; ʥ⡼
;;;
(defun tcode-toggle-katakana-mode (arg)
  "ʥ⡼ɤڤؤ롣"
  (interactive "P")
  (setq tcode-katakana-mode (if (null arg)
				(not tcode-katakana-mode)
			      (>= (prefix-numeric-value arg) 0)))
  (tcode-mode-line-redisplay))

(defun tcode-hiragana-to-katakana-char (char)
  "ʸ CHAR Ҥ餬ʤʤ饫ʤѴ롣
Ҥ餬ʤǤʤϤΤޤޤ֤ͤ"
  (let ((str (char-to-string char)))
    (if (string-match (concat "^[-]$") str)
	(if (tcode-nemacs-p)
	    (let ((ch (mod char 256)))
	      (+ (* ?\245 256) ch))
	  (let ((ch (char-component char 2)))
	    (make-character lc-jp ?\245 ch)))
      char)))

(defun tcode-hiragana-to-katakana-string (str)
  "ʸ STR ΤҤ餬ʤ򥫥ʤѴ롣"
  (mapconcat
   (function (lambda (c)
	       (char-to-string
		(tcode-hiragana-to-katakana-char c))))
   (tcode-string-to-char-list str)
   ""))

;;;
;;; ƥ⥸塼ǻѤѴؿ
;;;
(defun tcode-removable-fill-prefix-p ()
  "Ƥ褤 fill-prefix 
Ƥ褤 fill-prefix Ȥϡ
Ƭ point ޤǤ fill-prefix Ǥꡢ
ιԤ fill-prefix ǻϤޤäƤ򤤤"
  (and fill-prefix
       (and (string= fill-prefix
		     (buffer-substring (save-excursion
					 (beginning-of-line)
					 (point))
				       (point)))
	    (save-excursion
	      (and (= (forward-line -1) 0)
		   (looking-at (regexp-quote fill-prefix)))))))

(defun tcode-get-prev-nonspace ()
  "Return preceding non-space letter.  Move point to the beg' of that char."
  (and (tcode-removable-fill-prefix-p)
       (beginning-of-line))
  (while (memq (preceding-char) tcode-ignore-char-list)
    (tcode-forward-char -1)
    (and (tcode-removable-fill-prefix-p)
	 (beginning-of-line)))
  (prog1 (char-to-string (if (bobp) 0 (tcode-char-before (point))))
    (tcode-forward-char -1)))

(defun tcode-katakana-to-hiragana-char (char)
  "ʸ CHAR ʤʤҤ餬ʤѴ롣
ʤǤʤϤΤޤޤ֤ͤ"
  (let ((str (char-to-string char)))
    (if (string-match (concat "^[-]$") str)
	(if (tcode-nemacs-p)
	    (let ((ch (mod char 256)))
	      (+ (* ?\244 256) ch))
	  (let ((ch (char-component char 2)))
	    (make-character lc-jp ?\244 ch)))
      char)))

(defun tcode-katakana-to-hiragana-string (str)
  "ʸ STR ΥʤҤ餬ʤѴ롣"
  (mapconcat
   (function (lambda (c)
	       (char-to-string
		(tcode-katakana-to-hiragana-char c))))
   (tcode-string-to-char-list str)
   ""))

;;;
;;; Ѵ
;;;
(provide 'tc)

(unless (or (get-buffer tcode-bushu-buffer-name)
	    (< 0 tcode-bushu-on-demand))
  (require 'tc-bushu)
  (tcode-bushu-init 999))

;;; tc.el ends here