;;; tc-help.el --- help routines for T-Code

;; Copyright (C) 1997 Kaoru Maeda, Yasushi Saito and Akira Kitajima.

;; Author: Kaoru Maeda <maeda@src.ricoh.co.jp>
;;	Yasushi Saito <yasushi@cs.washington.edu>
;;	Akira Kitajima <kitajima@ics.es.osaka-u.ac.jp>
;; Maintainer: Akira Kitajima
;; Created: 3 Apr 1997
;; Version: $Id: tc-help.el,v 2.0.6.0 1999/02/08 01:30:31 kitajima 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)

;;;; ѿ

(defvar tcode-strict-help t
  "* non-nil ΤȤѴˤϤǤ뤫ɤܤĴ٤롣
nil ξǤϸĤʤ褦ʾǤ⡢non-nil ˤиĤ礬
롣ʤ֤뤳Ȥ⤢롣")

(defvar tcode-help-first-stroke ""
  "* إɽǸ֤ɽ魯ʸ")
(defvar tcode-help-second-stroke ""
  "* إɽǸ֤ɽ魯ʸ")
(defvar tcode-help-third-stroke ""
  "* إɽ軰Ǹ֤ɽ魯ʸ")
(defvar tcode-help-forth-stroke ""
  "* إɽǸ֤ɽ魯ʸ")
(defvar tcode-help-same-stroke ""
  "* إɽʣ󤳤ΰ֤򲡤Ȥɽ魯ʸ")
(defvar tcode-help-optional-same-stroke ""
  "* إɽʣ󤳤ΰ֤򲡤Ȥɽ魯ʸ
`tcode-help-same-stroke' ˻ѤƤ˻Ѥ롣")

(defvar tcode-help-draw-top-keys t
  "* ȥɽǺǾʤΥɽ뤫")

(defvar tcode-last-help-char nil
  "Ǹ˥إפɽʸ")

;;;; ⡼ɤΥإ

;;;###autoload
(defun tcode-mode-help ()
  "T-Code ⡼ɤΥƤʤɤɽ롣"
  (interactive)
  (let ((buf (get-buffer-create " *T-Code Mode Help*")))
    (set-buffer buf)
    (erase-buffer)
    (if tcode-mode-help-string
	(insert (substitute-command-keys tcode-mode-help-string))
      (insert (documentation 'tcode-activate))
      (goto-char (point-min))
      (forward-line 1)
      (narrow-to-region (point) (point-max)))
    (tcode-display-help-buffer buf)
    (kill-buffer buf)))

;;;; إɽ

;;;###autoload
(defun tcode-query-stroke (p)
  "PˤʸǤɽ롣"
  (interactive "d")
  (let ((ch (buffer-substring (save-excursion
				(goto-char p)
				(tcode-forward-char 1)
				(point))
			      p)))
    (tcode-display-stroke-for-char ch)))

(defun tcode-construct-nested-bushu-help (ch kanji-list)
  "ҤˤʤѴˡʸ롣"
  (if (or (null tcode-strict-help)
	  (tcode-stroke-for-char ch))
      ch
    (let ((decomposed (tcode-decompose-char ch t)))
      (if (or (null decomposed)
	      (member (car decomposed) kanji-list)
	      (member (cdr decomposed) kanji-list))
	  (concat "[" ch "]")
	(setq kanji-list (cons ch kanji-list))
	(concat "("
		(tcode-construct-nested-bushu-help (car decomposed) kanji-list)
		" + "
		(tcode-construct-nested-bushu-help (cdr decomposed) kanji-list)
		")")))))

(defun tcode-make-drawing-data (stroke)
  "STROKE Ǥ޼뤿Υǡ롣
ǡϡΥꥹȤΥꥹȡ
  (0-39)  (ʤ)  ֤򼨤ʸ(ʤ)"
  (let ((1st (car stroke))
	(2nd (car (cdr stroke)))
	(3rd (car (cdr (cdr stroke))))
	(4th (car (cdr (cdr (cdr stroke)))))
	draw-data)
    (setq draw-data
	  (list (cons 1st
		      (if (memq 1st (cdr stroke))
			  (list tcode-help-same-stroke
				(cond ((and 4th 3rd
					    (= 1st 2nd)
					    (= 1st 3rd)
					    (= 1st 4th))
				       (setq 2nd nil 3rd nil 4th nil)
				       "졢軰")
				      ((and 3rd (= 1st 2nd) (= 1st 3rd))
				       (setq 2nd nil 3rd nil)
				       "졢軰")
				      ((and 4th 3rd (= 1st 2nd) (= 1st 4th))
				       (setq 2nd nil 4th nil)
				       "졢")
				      ((and 4th 3rd (= 1st 3rd) (= 1st 4th))
				       (setq 3rd nil 4th nil)
				       "졢軰")
				      ((and 4th 3rd (= 1st 4th))
				       (setq 4th nil)
				       "졢")
				      ((and 3rd (= 1st 3rd))
				       (setq 3rd nil)
				       "졢軰")
				      ((= 1st 2nd) (setq 2nd nil)
				       "졢")))
			(list tcode-help-first-stroke "")))))
    (and 2nd
	 (setq draw-data
	       (nconc draw-data
		      (list (cons 2nd
				  (if (memq 2nd (cdr (cdr stroke)))
				      (list
				       (if (and (= (length stroke) 4)
						(or (null 3rd) (null 4th)))
					   tcode-help-optional-same-stroke
					 tcode-help-same-stroke)
				       (cond ((and 3rd 4th
						   (= 2nd 3rd) (= 2nd 4th))
					      (setq 3rd nil 4th nil)
					      "軰")
					     ((and 3rd (= 2nd 3rd))
					      (setq 3rd nil)
					      "軰")
					     ((and 4th (= 2nd 4th))
					      (setq 4th nil)
					      "")))
				    (list tcode-help-second-stroke "")))))))
    (and 3rd
	 (setq draw-data
	       (nconc draw-data
		      (list (cons 3rd
				  (if (and 4th (= 3rd 4th))
				      (list
				       (if (null 2nd)
					   tcode-help-optional-same-stroke
					 tcode-help-same-stroke)
				       (progn
					 (setq 4th nil)
					 ""))
				    (list tcode-help-third-stroke "")))))))
    (and 4th
	 (setq draw-data
	       (nconc draw-data
		      (list (list 4th tcode-help-forth-stroke "")))))
    draw-data))

(defun tcode-draw-stroke-for-char (stroke)
  "STROKE Ǥɽޤ"
  (let ((draw-data (tcode-make-drawing-data stroke))
	(i 0))
    (insert "\
                      \n\
      
      
      ")
    (while draw-data
      (let* ((datum (car draw-data))
	     (addr (car datum))
	     (char (car (cdr datum)))
	     (str (car (cdr (cdr datum)))))
	(tcode-help-stroke (tcode-get-key-location addr) char)
	(goto-line (if (= (mod i 2) 0) 3 4))
	(end-of-line)
	(insert "     " char ": " str "Ǹ")
	(setq i (1+ i)
	      draw-data (cdr draw-data))))))

(defun tcode-auto-remove-help-char ()
  "ʸ tcode-last-help-char õƾõ"
  (and (eq tcode-auto-help 'delete-the-char)
       (progn
	 (search-backward tcode-last-help-char)
	 (delete-region (match-beginning 0)
			(match-end 0))
	 (ding))))

;;;###autoload
(defun tcode-display-stroke-for-char (ch &optional append)
  "CH(Ѱʸ)Ǥɽ"
  (interactive "sHelp:\nP")
  (if (or (null ch)
	  (string= ch ""))
      (progn
	(tcode-verbose-message "إפʸޤ")
	(ding))
    (let* ((stroke (tcode-stroke-for-char ch))
	   (buf (get-buffer-create " *stroke2*"))
	   decomposed-string)
      (save-excursion
	(set-buffer buf)
	(erase-buffer)
	(and stroke
	     (<= (length stroke) 4)
	     (tcode-draw-stroke-for-char stroke))
	(let* ((decomposed
		(tcode-decompose-char ch
				      (and tcode-strict-help
					   (not stroke))))
	       (help-string
		(cond ((null decomposed)
		       ch)
		      (stroke
		       (concat ch
			       " = "
			       (car decomposed)
			       " + "
			       (cdr decomposed)))
		      (t
		       (concat ch
			       " = "
			       (setq decomposed-string
				     (concat
				      (tcode-construct-nested-bushu-help
				       (car decomposed)
				       (list ch))
				      " + "
				      (tcode-construct-nested-bushu-help
				       (cdr decomposed)
				       (list ch)))))))))
	  (if (null stroke)
	      (message help-string)
	    (goto-char (point-min))
	    (end-of-line)
	    (insert "     " help-string)
	    (tcode-display-help-buffer " *stroke2*" t append))))
      (and decomposed-string
	   (tcode-display-direct-stroke decomposed-string "()" stroke))
      (setq tcode-last-help-char ch))))


(defun tcode-get-key-location (address)
  (cons (/ address 10) (1+ (% address 10))))
(defun tcode-key-address-right-p (address)
  (let ((location (tcode-get-key-location address)))
    (>= (cdr location) 6)))
(defun tcode-key-address-left-p (address)
  (let ((location (tcode-get-key-location address)))
    (< (cdr location) 6)))

(defun tcode-help-stroke (loc ch)
  "subroutine of tcode-display-stroke-for-char"
  (goto-line (1+ (car loc)))
  (move-to-column (+ (* 2 (cdr loc)) (if (>= (cdr loc) 6) 0 -2)))
  (tcode-delete-char (if (= (tcode-char-width (tcode-char-after (point)))
			    2) 1 2))
  (insert ch))

;;;###autoload
(defun tcode-display-direct-stroke (kakutei &optional yomi append)
  "KAKUTEI ǡ YOMI ˴ޤޤ줺ľϤǤɽ롣"
  (and (not (string-match " \\*Mini" (buffer-name (current-buffer))))
       (let ((yomi-list (tcode-string-to-char-list yomi))
	     (kakutei-list (tcode-string-to-char-list kakutei))
	     (display-first-time (not append))
	     displayed)
	 (while kakutei-list
	   (let ((ch (car kakutei-list)))
	     (and (not (memq ch yomi-list))
		  (tcode-stroke-for-char
		   (char-to-string ch))
		  (progn
		    (tcode-display-stroke-for-char
		     (char-to-string ch)
		     (not display-first-time))
		    (setq display-first-time nil
			  displayed t))))
	   (setq kakutei-list (cdr kakutei-list)))
	 displayed)))

;;;; ȥɽ

;;;###autoload
(defun tcode-show-tables (first second)
  (interactive)
  (let* ((buf (draw-tcode-tables first second)))
    (if tcode-auto-zap-table
	(save-window-excursion
	  (tcode-display-help-buffer buf)
	  (sit-for 0)
	  (tcode-redo-command (read-char)))
      (let ((orig-buf (current-buffer)))
	(set-buffer buf)
	(goto-char (point-min))
	(set-buffer orig-buf))
      (tcode-display-help-buffer buf))))

(defun tcode-make-table-line (k1 k2)
  "subroutine of tcode-make-LR-block"
  (let ((i1 k1) (j 0) c)
    (while (< j 5)
      (let ((a (aref (aref tcode-table i1) k2)))
	(setq c (if (null a)
		    ""
		  (tcode-action-to-printable a)))
	(insert c)
	(if (= (tcode-char-width (tcode-string-to-char c)) 1) (insert " ")))
      (setq j (1+ j)
	    i1 (1+ i1)))))

(defun tcode-make-LR-block (k1-start k2-start)
  "subroutine of tcode-insert-stroke-file"
  (or tcode-help-draw-top-keys
      (setq k1-start (+ k1-start 10)
	    k2-start (+ k2-start 10)))
  (let ((k1 k1-start)
	(k2 k2-start)
	y x yy)
    (setq yy (if tcode-help-draw-top-keys 0 1))
    (while (< yy 4)
      (setq y (if tcode-help-draw-top-keys 0 1))
      (setq k1 k1-start)
      (while (< y 4)
	(setq k2 k2-start)
	(insert "\n  ")
	(setq x 0)
	(while (< x 5)
	  (tcode-make-table-line k1 k2)
	  (insert "  ")
	  (setq x (1+ x))
	  (setq k2 (1+ k2)))
	(setq y (1+ y))
	(setq k1 (+ 10 k1)))
      (setq k2-start (+ 10 k2-start))
      (insert "\n")
      (setq yy (1+ yy)))))

(defun tcode-insert-stroke-file (&optional force)
  "Make the stroke table and writeout the content into
tcode stroke help table file if it is older than tcode
table."
  (erase-buffer)
  (if (and (not force)
	   (file-exists-p tcode-stroke-file-name)
	   (file-newer-than-file-p tcode-stroke-file-name
				   tcode-table-file-name))
      (insert-file-contents tcode-stroke-file-name)
    (insert "\nLL\n")
    (tcode-make-LR-block 0 0)
    (insert "\nLR\n")
    (tcode-make-LR-block 0 5)
    (insert "\nRL\n")
    (tcode-make-LR-block 5 0)
    (insert "\nRR\n")
    (tcode-make-LR-block 5 5)
    (write-file tcode-stroke-file-name)))

(defun draw-tcode-tables (first second &optional force)
  "Draw tcode stroke tables.
FIRST corresponds to the first stroke. If nil, then left, else right.
SECOND to the second stroke.  If nil, then left, else right.
If FORCE is non-nil, make new table."
  (let ((buf (get-buffer-create tcode-stroke-buffer-name))
	(str (concat "^" (if first "R" "L") (if second "R" "L"))))
    (save-excursion
      (set-buffer buf)
      (widen)
      (goto-char (point-min))
      (if (and (not force)
	       (re-search-forward str nil  t))
	  (progn
	    (forward-line 0)
	    (let ((top (point))
		  (end
		   (progn
		     (forward-line 3)
		     (if (re-search-forward "^[RL]" nil t)
			 (progn(forward-line -1)(point))
		       (point-max)))))
	      (narrow-to-region top end)
	      buf))
	(tcode-insert-stroke-file force)
	(draw-tcode-tables first second)))))

(provide 'tc-help)

;;; tc-help.el ends here