;;; eelll.el --- EELLL (ELisp implemented CATTT)

;; Copyright (C) 1991--97  Kaoru Maeda, Yasushi Saito and Akira Kitajima

;; Author: Kaoru Maeda <maeda@src.ricoh.co.jp>
;;	Yasushi Saito <yasushi@is.s.u-tokyo.ac.jp>
;;	Akira Kitajima <kitajima@ics.es.osaka-u.ac.jp>
;; Maintainer: Akira Kitajima
;;
;; $Id: eelll.el,v 2.0.6.1 2000/03/08 23:28:30 akira Exp akira $
;;
;; 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:

(provide 'eelll)

(require 'tc-sysdep)
(require 'tc)
(require 'tc-help)
(autoload 'Helper-describe-mode "helper" nil t)
(tcode-init)

;;
;;  Version
;;
(defun eelll-version ()
  "EELLL ΥСɽ롣"
  (interactive)
  (if (interactive-p)
      (message "EELLL version %s" (eelll-version))
    (substring "$Revision: 2.0.6.1 $" 11 -2)))

;;
;;  Variable
;;

(defvar eelll-text (concat tcode-data-directory "EELLLTXT")
  "*EELLLƥȥե")

(defvar eelll-move-cursor nil
  "*non-nilˤȥϤΤӤ˥ʤ")

(defvar eelll-configuration-file-name (concat tcode-data-directory
					      "eelll-conf.el")
  "* EELLL ե롣
ΥեϼưŪ˽񤭴Τǡ
桼ƤѹƤϤʤ")

(defvar eelll-last-lesson nil
  "Ǹåֹ")

(load eelll-configuration-file-name t)

(defconst eelll-buffer-name "*EELLL*"
  "*EELLL Хåե̾")

(defvar eelll-text-buffer " *eelll-text*"
  "EELLLƥȤƤХåե̾")

(defvar eelll-help-remove-interval 25
  "*EELLL äޤǤλ()")

(defconst eelll-help-buffer-name " *EELLL-Help*"
  "*EELLL ǤɽХåե̾")

(defvar eelll-original-window-configuration nil)
(defvar eelll-window-configuration nil)

(defvar eelll-total-time 0)
(defvar eelll-total-stroke 0)
(defvar eelll-total-error 0)
(defvar eelll-lesson-no nil)
(defvar eelll-first-hand nil)
(defvar eelll-second-hand nil)
(defvar eelll-upper-row nil)
(defvar eelll-lesson-chars nil)
(defvar eelll-text-line nil)
(defvar eelll-text-stroke nil)
(defvar eelll-unmap-table nil)
(defvar eelll-start-time nil)
(defvar eelll-strokes 0)
(defvar eelll-error-strokes 0)
(defvar eelll-lesson-string nil)
(defvar eelll-lesson-pattern-string nil)

;;
;;  Text
;;

(defun eelll-prepare-text (num)
  "ƥNUMѰդ롣NUMnilʤмΥåѰդ롣"
  (save-excursion
    (set-buffer (get-buffer-create eelll-text-buffer))
    (widen)
    (if (zerop (buffer-size))
	(progn
	  (insert-file-contents eelll-text)
	  (setq buffer-read-only t)
	  (set-buffer-modified-p nil)))
    (goto-char (point-min))
    (or (if num
	    (re-search-forward
	     (concat "\f\nLesson \\(" (int-to-string num) "\\):") nil t)
	  (and (or (null eelll-last-lesson)
		   (re-search-forward (concat "\f\nLesson \\("
					      (int-to-string eelll-last-lesson)
					      "\\):")
				      nil t))
	       (re-search-forward "\f\nLesson \\([0-9]+\\):" nil t)))
	(error "ƥ%sϤޤ" (if num (int-to-string num) "")))
    (setq eelll-lesson-string (buffer-substring (match-beginning 1)
						(match-end 1))
	  eelll-lesson-no (string-to-int eelll-lesson-string))
    (setq eelll-first-hand (looking-at "[Rr]"))
    (setq eelll-second-hand (looking-at ".[Rr]"))
    (setq eelll-upper-row (looking-at "..!"))
    (forward-line 1)
    (if (looking-at "^Lesson-chars: ")
	(let ((eol (save-excursion (end-of-line 1) (point))))
	  (skip-chars-forward "^ " eol)
	  (setq eelll-lesson-chars (buffer-substring (1+ (point)) eol))
	  (forward-line 1)))
    (let ((p (point)))
      (forward-page 1)
      (narrow-to-region p (1- (point)))
      (goto-char p)))
  (setq eelll-last-lesson eelll-lesson-no))


(defun eelll-lesson-line ()
  "ƥȤμιԤȤäƤ롣ʤnil֤
eelll-text-line:	᡼
eelll-text-stroke:	ȥ᡼"
  (save-excursion
    (set-buffer eelll-text-buffer)
    (skip-chars-forward " \t\n\f" (point-max))
    (and (not (eobp))
	 (let ((p (point)))
	   (forward-line 1)
	   (setq eelll-text-line (buffer-substring p (1- (point))))
	   (setq eelll-text-stroke (eelll-stroke eelll-text-line))
	   eelll-text-line))))

(defun eelll-stroke (str)
  "STRϤ뤿Υȥ֤"
  (mapconcat
   (function
    (lambda (ch)
      (let ((c (eelll-stroke-for-char (char-to-string ch))))
	(if (= ch ? )
	    (list ? )
	  (and c
	       (list (aref eelll-unmap-table (car c))
		     (aref eelll-unmap-table (car (cdr c)))))))))
   (tcode-string-to-char-list str) nil))

(defvar eelll-stroke-for-char-hash (make-vector 127 nil))

(defun eelll-stroke-for-char (ch)
  "CH(Ѱʸ)Ǥ֤T-CodeϤǤʤnil֤"
  (or (tcode-stroke-for-char ch)
      (tcode-stroke-for-char (tcode-2-to-1 ch))))

(defvar eelll-unmap-table nil)
(or eelll-unmap-table
    (progn
      (setq eelll-unmap-table (make-string 40 ?@))
      (let ((i 0)
	    (max (length tcode-keymap-table))
	    k)
	(while (< i max)
	  (if (<= 0 (setq k (aref tcode-keymap-table i)))
	      (aset eelll-unmap-table k (+ i 32)))
	  (setq i (1+ i))))))

;;
;;  Stroke chart
;;
(defun eelll-draw-chart ()
  "ƥȤоݤȤʤʸΥȥɽ"
  (save-excursion
    (set-buffer (get-buffer-create eelll-help-buffer-name))
    (widen)
    (erase-buffer)
    (goto-char (point-min))
    (let ((i 0)
	  j k
	  (c (if eelll-second-hand 1 4)))
      (while (< i 4)
	(setq i (1+ i) j 0)
	(while (< j 4)
	  (insert "    ")
	  (setq j (1+ j) k 0)
	  (while (< k 5)
	    (setq k (1+ k))
	    (insert "  ")
	    (if (= k c) (insert "  ")))
	  (delete-horizontal-space)
	  (insert "\n"))
	(if (< i 4) (insert "\n"))))
    (let (fr fc sr sc)
      (mapcar
       (function
	(lambda (c)
	  (setq fr (eelll-stroke-for-char (char-to-string c))
		sr (car (cdr fr))
		fc (% (car fr) 5)
		fr (/ (car fr) 10)
		sc (% sr 5)
		sr (/ sr 10))
	  (goto-line (+ (* sr 5) fr 1))
	  (move-to-column (+ 4 (* 12 sc) (* 2 fc)
			  (if (> sc (if eelll-second-hand 0 3)) 2 0)))
	  (tcode-delete-char 1)
	  (insert (char-to-string c))))
       (tcode-string-to-char-list eelll-lesson-chars)))
    (goto-char (point-min))
    (forward-line 1)
    (delete-region (point-min) (point))
    (if eelll-upper-row
	()
      (forward-line 5)
      (delete-region (point-min) (point))
      (forward-line 4)
      (delete-region (point)
		     (save-excursion (forward-line 1)
				     (point)))
      (forward-line 4)
      (delete-region (point)
		     (save-excursion (forward-line 1)
				     (point))))
    (setq eelll-lesson-pattern-string (concat (if eelll-first-hand "R" "L")
					      "->"
					      (if eelll-second-hand "R" "L")))
    (set-buffer-modified-p nil)))

;;
;;  String Matching
;;
(defun eelll-remove-one-space-in-list (list)
  (if list
      (let ((elm (car list)))
	(if (and (= elm ? )
		 (= (car (cdr list)) ? ))
	    (cons ?  ; space
		  (eelll-remove-one-space-in-list (cdr (cdr list))))
	  (cons elm (eelll-remove-one-space-in-list (cdr list)))))
    nil))

(defun eelll-match (template string quest)
  "TEMPLATE򤪼ܤȤϤ줿ʸSTRINGκ򤹤롣ʸQUEST
ǤΥꥹ(RESULT ERROR)֤"
  (let ((link (list  '(0 . 0)))
	(len-1 (1- (length string)))
	(max (length template))
	(j 0) i)
    (while (< j max)
      (setq i 0)
      (while (< i len-1)
	(and (= (aref template j) (aref string i))
	     (= (aref template (1+ j)) (aref string (1+ i)))
	     (let ((l link) (p nil) (i+2 (+ i 2)) (j+2 (+ j 2)) dif)
	       (while l
		 (if (and (>= i (car (car l)))
			  (>= j (cdr (car l))))
		     (setq l nil)
		   (setq p (car l) l (cdr l))))
	       (if p
		   (if (or (> (setq dif (- (+ (car p) (cdr p)) i+2 j+2)) 0)
			   (and (= dif 0) (> i+2 (car p))))
		       (progn (setcar p i+2)
			      (setcdr p j+2)))
		 (setq link (cons (cons i+2 j+2) link)))))
	(setq i (1+ i)))
      (setq j (+ j 2)))
    (let ((res (vconcat (tcode-string-to-char-list string)))
	  (quest-v (vconcat (eelll-remove-one-space-in-list
			     (tcode-string-to-char-list quest))))
	  (pi (length string))
	  (pj max)
	  (err 0)
	  (l link))
      (while (> (setq i (car (car l))) 0)
	(setq j (cdr (car l))
	      l (cdr l)
	      err (+ err (max (- pi i) (- pj j)) -2))
	(aset res (- i 2) nil)
	(aset res (- i 1) (aref quest-v (- (/ j 2) 1)))
	(setq pi i pj j))
      (setq err (+ err (max pi pj)))
      (setq res
	    (mapconcat (function
			(lambda (ch)
			  (and ch
			       (if (= ch ? )
				   "  "
				 (char-to-string ch)))))
			res nil))
      (list res err))))

;;
;;  Mode setup
;;

(defvar eelll-mode-map nil
  "EELLL ⡼ɤǻȤޥå")
(if eelll-mode-map
    ()
  (setq eelll-mode-map (make-keymap))
  (substitute-key-definition nil 'eelll-undefined eelll-mode-map)
  (define-key eelll-mode-map "\177" 'eelll-delete-char)
  (define-key eelll-mode-map "\e" 'ESC-prefix)
  (define-key eelll-mode-map "\C-c" 'mode-specific-command-prefix)
  (define-key eelll-mode-map "\C-j" 'eelll-return)
  (define-key eelll-mode-map "\C-m" 'eelll-return)
  (define-key eelll-mode-map "\C-g" 'eelll-confirm-quit)
  (define-key eelll-mode-map "\C-l" 'eelll-redisplay)
  (define-key eelll-mode-map "\C-u" 'universal-argument)
  (define-key eelll-mode-map "\C-x" 'Control-X-prefix)
  (define-key eelll-mode-map "\C-]" 'abort-recursive-edit)
  (define-key eelll-mode-map "?" 'eelll-help)
  (define-key eelll-mode-map " " 'eelll-key)
  (mapcar
   (function
    (lambda (key)
      (define-key eelll-mode-map (char-to-string key) 'eelll-key)))
   eelll-unmap-table))

(defun eelll-mode ()
  "EELLL  Emacs Lisp Ǽ¸줿 T-Code ץǤ
̤ɽ줿ʸ򤽤ΤޤϤƤ
ԤϤä꥿󥭡ǤäƤ

̤ξȾʬˤϺΥåǽʸΥȥɽɽƤޤ

EELLL ǤϤۤȤɤΥޥɤػߤƤޤ
ޤ \\[switch-to-buffer] ¾ΥХåե˰ܤäƤ\
ޥɤ¹ԤƤ
ʤ\\[eelll-confirm-quit]  EELLL Ǥޤ"
  (use-local-map eelll-mode-map)
  (setq major-mode 'eelll-mode)
  (setq mode-name "EELLL")
  (setq mode-line-format "-----EELLL%-")
  (run-hooks 'eelll-mode-hook))

(defun eelll-help ()
  "EELLL ɽ롣"
  (interactive)
  (Helper-describe-mode)
  (kill-buffer "*Help*")
  (eelll-redisplay))

(defun eelll-undefined ()
  (interactive)
  (message (substitute-command-keys
	    "\\[switch-to-buffer] SOME-BUFFER first.")))

(defun eelll-delete-char ()
  (interactive)
  (message "ְ㤤򵤤ˤɤɤϤƤ"))


;;
;; Ѥ䴰դcompleting-read
;;
;;; "?"ǰޤ

(defun eelll-completing-read ()
  "䴰դǡƥֹߥ˥ХåեϤ롣
MulecompletionμΤᡤ?פ
Ϥˤϸʤ"
  (let (lesson-alist key val orig-minibuffer-completion-help)
    (save-excursion
      (set-buffer (get-buffer-create eelll-text-buffer))
      (widen)
      (if (zerop (buffer-size))
	  (progn
	    (insert-file-contents eelll-text)
	    (setq buffer-read-only t)
	    (set-buffer-modified-p nil)))
      (goto-char (point-min))
      (while (re-search-forward "^Lesson \\([0-9]+\\):[rRlL]+" nil t)
	(setq key (buffer-substring (match-beginning 1) (match-end 1)))
	(forward-line 2)
	(setq val (buffer-substring (point)
				    (save-excursion (end-of-line) (point))))
	(setq lesson-alist (cons (cons key val) lesson-alist))))
    (setq orig-minibuffer-completion-help
	  (symbol-function 'minibuffer-completion-help))
    (unwind-protect
	(progn
	  (fset 'minibuffer-completion-help
		(symbol-function 'eelll-minibuffer-completion-help))
	  (let ((str (completing-read "ƥ['?'ǰ]: "
				      lesson-alist nil t
				      (if eelll-last-lesson
					  (format "%d" eelll-last-lesson)
					""))))
	    (if (string= str "")
		nil
	      (list (string-to-int str)))))
      (fset 'minibuffer-completion-help orig-minibuffer-completion-help))))

(defun eelll-minibuffer-completion-help ()
  "minibuffer-completion-help֤"
  (interactive)
  (with-output-to-temp-buffer "*Completions*"
    (eelll-display-completion-list
     (all-completions (buffer-string) minibuffer-completion-table))))

(defun eelll-display-completion-list (x)
  "display-completion-list֤"
  (princ "    ---- ƥȰ ----\n")
  (setq x (sort x '(lambda (x y)
		     (< (string-to-int x) (string-to-int y)))))
  (while x
    (princ (car x))
    (princ ":")
    (princ (cdr (assoc (car x) lesson-alist)))
    (princ "\n")
    (setq x (cdr x))))



;;
;;  Main Driver
;;

(defun eelll (&optional lesson)
  "EELLL Ϥ롣ܤ eelll-mode β򸫤衣"
  (interactive (eelll-completing-read))
  (setq eelll-original-window-configuration (current-window-configuration))
  (eelll-prepare-text lesson)
  (eelll-setup-lesson)
  (message (substitute-command-keys "\\[eelll-help] ǥإ")))

(defun eelll-setup-lesson ()
  (eelll-draw-chart)
  (switch-to-buffer eelll-buffer-name)
  (buffer-disable-undo)
  (eelll-mode)
  (widen) (erase-buffer)
  (delete-other-windows)
  (split-window-vertically
   (save-excursion
     (set-buffer eelll-help-buffer-name)
     (setq mode-line-format
	   '("-----EELLL Help"
	     (eelll-lesson-string
	      (": lesson " eelll-lesson-string))
	     (eelll-lesson-pattern-string
	      ("  (" eelll-lesson-pattern-string ")"))
	     "%-"))
     (1+ (count-lines (point-min) (point-max)))))
  (switch-to-buffer eelll-help-buffer-name)
  (goto-char (point-min))
  (other-window 1)
  (setq eelll-window-configuration (current-window-configuration))
  (setq eelll-start-time nil
	eelll-error-strokes 0
	eelll-strokes 0)
  (save-excursion
    (set-buffer eelll-text-buffer)
    (goto-char (point-min)))
  (insert "꥿󥭡ǤƤлϤޤޤ: "))

(defun eelll-key ()
  (interactive)
  (save-excursion
    (set-buffer " *eelll-strokes*")
    (insert (char-to-string last-command-char)))
  (if eelll-move-cursor
      (insert " ")))

(defun eelll-return ()
  (interactive)
  (if eelll-start-time
      (progn
	(delete-region (point) (progn (beginning-of-line 1) (point)))
	(let* ((str (save-excursion
		      (set-buffer " *eelll-strokes*")
		      (buffer-string)))
	       (res (eelll-match eelll-text-stroke str eelll-text-line))
	       (err (car (cdr res))))
	  (insert (car res))
	  (setq eelll-strokes (+ eelll-strokes (length str))
		eelll-error-strokes (+ eelll-error-strokes err))))
    (setq eelll-start-time (eelll-current-time)))
  (if (null (eelll-lesson-line))
      (eelll-end-lesson)
    (save-excursion
      (set-buffer (get-buffer-create " *eelll-strokes*"))
      (widen) (erase-buffer))
    (insert "\n\n" eelll-text-line "\n")
    (eelll-redisplay)))

(defun eelll-redisplay ()
  "EELLL β̤ɽľ"
  (interactive)
  (set-window-configuration eelll-window-configuration)
  (goto-char (point-max))
  (set-window-start
   (selected-window)
   (save-excursion (forward-line (- 2 (window-height))) (point))))

(defun eelll-current-time ()
  (let ((str (current-time-string)))
    (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)" str)
    (+ (* 3600 (string-to-int (substring str
					 (match-beginning 1)
					 (match-end 1))))
       (* 60 (string-to-int (substring str (match-beginning 2) (match-end 2))))
       (string-to-int (substring str (match-beginning 3) (match-end 3))))))

(defun eelll-percentage (num den)
  (let ((res%  (min 9999 (/ num (max 1 den)))))
    (format "%d.%d" (/ res% 10) (% res% 10))))

(defun eelll-stroke-per-min (stroke sec)
  "ʬΥȥɽʸ֤"
  (while (>= stroke 10000)
    (setq sec (if (oddp sec)
		  (1+ (/ sec 2))
		(/ sec 2))
	  stroke (if (oddp stroke)
		     (1+ (/ stroke 2))
		   (/ stroke 2))))
  (setq stroke (* stroke 600))
  (let ((10stroke-per-min (/ stroke sec)))
    (if (< 10stroke-per-min 100)
	(format "%d.%1d" (/ 10stroke-per-min 10) (% 10stroke-per-min 10))
      (format "%d" (/ 10stroke-per-min 10)))))

(defun eelll-time-per-stroke (time stroke)
  "쥹ȥλ֤ɽʸ֤"
  (if (>= time stroke)
      (let ((10time-per-stroke (/ (* time 10) stroke)))
	(format "%d.%d " (/ 10time-per-stroke 10) (% 10time-per-stroke 10)))
    (while (>= time 8000)
      (setq time (if (oddp time)
		     (1+ (/ time 2))
		   (/ time 2))
	    stroke (if (oddp stroke)
		       (1+ (/ stroke 2))
		     (/ stroke 2))))
    (let ((1000time-per-stroke (/ (* time 1000) stroke)))
      (format "%d ߥ" 1000time-per-stroke))))

(defun eelll-display-score (time stroke err)
  (let ((cnt (- stroke err)))
    (set-buffer eelll-buffer-name)
    (insert "\n\n(Ǹ)Ǹ "
	    (eelll-time-per-stroke time stroke) ", "
	    "ʬ " (eelll-stroke-per-min stroke time) " Ǹ.\n")
    (if (> cnt 0)
	(insert "(Ǹ)Ǹ "
	    (eelll-time-per-stroke time cnt) ", "
	    "ʬ " (eelll-stroke-per-min cnt time) " Ǹ.\n"))
    (if (> eelll-strokes 0)
	(insert "              顼졼 "
		(eelll-percentage (* 1000 err) stroke)
		"%.\n"))))

(defun eelll-end-lesson ()
  (let ((time (% (- (eelll-current-time) eelll-start-time -86399) 86400)))
    (setq eelll-total-time (+ eelll-total-time time)
	  eelll-total-stroke (+ eelll-total-stroke eelll-strokes)
	  eelll-total-error (+ eelll-total-error eelll-error-strokes))
    (eelll-display-score time eelll-strokes eelll-error-strokes)
    (delete-other-windows)
    (set-window-start
     (selected-window)
     (save-excursion
       (forward-line (- 1 (window-height))) (point)))
    (if (y-or-n-p "⤦٥ȥ饤ޤ: ")
	(eelll-setup-lesson)
      (if (y-or-n-p "Υå˿ʤߤޤ: ")
	  (progn (eelll-prepare-text nil)
		 (eelll-setup-lesson))
	(eelll-end))))
  (message ""))

(defun eelll-save-configuration ()
  "`eelll-last-lesson' ͤե¸롣
ե̾ `eelll-configuration-file-name' ǻꤹ롣"
  (and eelll-configuration-file-name
       (save-excursion
	 (kill-buffer
	  (prog1
	      (set-buffer (get-buffer-create "  *eelll temp*"))
	    (insert (format "(setq eelll-last-lesson %d)\n" eelll-last-lesson))
	    (let ((backup-inhibited t))
	      (write-file eelll-configuration-file-name)))))))

(defun eelll-confirm-quit ()
  "EELLL λ뤫ɤǧλ롣"
  (interactive)
  (and (y-or-n-p "EELLL λޤ: ")
       (eelll-end t)))

(defun eelll-end (&optional abort)
  (if abort
      ()
    (set-buffer eelll-buffer-name)
    (widen)
    (erase-buffer)
    (insert "\n\n")
    (eelll-display-score eelll-total-time eelll-total-stroke eelll-total-error)
    (insert "\n    Ǹ " (int-to-string eelll-total-stroke) " Ǹ. ")
    (insert "׻ " (int-to-string eelll-total-time) " .\n")
    (eelll-save-configuration)
    (message "Ĥ줵ޤǤɤ줫򤪤Ƥ")
    (condition-case ()
	(read-char)
      (error)))
  (kill-buffer eelll-help-buffer-name)
  (set-window-configuration eelll-original-window-configuration)
  (message ""))

(defun eelll-compile-text (recompile-all)
  "ƥȤLesson-chars: Ԥ.
Prefix arg RECOMPILE-ALL  non-nil ξˤϡ
¸Lesson-chars:ƺƤ鿷˺ľ"
  (interactive "P")
  (find-file eelll-text)
  (let ((reached-eob nil) (eelll-buffer (current-buffer)))
    (save-restriction
      (widen)
      (goto-char (point-min))
      (save-excursion
	(set-buffer (get-buffer-create " *lessons*"))
	(delete-region (point-min) (point-max)))
      (while (and (not reached-eob) (not (eobp)))
	(let ((point (point)))
	  (narrow-to-page 1)
	  (if (= point (point)) (setq reached-eob t)))
	(goto-char (point-min))
	(skip-chars-forward "^0-9")
	(message (buffer-substring (point)
				   (save-excursion (end-of-line 1) (point))))
	(skip-chars-forward "^:" (save-excursion (end-of-line 1) (point)))
	(setq eelll-first-hand (looking-at ":[Rr]"))
	(setq eelll-second-hand (looking-at ":.[Rr]"))
	(forward-line 1)
	(if (and recompile-all (looking-at "^Lesson-chars: "))
	    (delete-region (point) (save-excursion (forward-line) (point))))
	(if (not (looking-at "^Lesson-chars: "))
	    (let ((where (point))
		  (chars nil)
		  (upper nil)
		  c last)
	      (while (not (eobp))
		(skip-chars-forward " \t\n\f" (point-max))
		(while (not (eolp))
		  (setq chars (cons (buffer-substring (point)
						      (progn (forward-char 1)
							     (point)))
				    chars))))
	      (setq chars (sort chars 'string<))
	      (goto-char where)
	      (if chars (insert "Lesson-chars: "))
	      (while chars
		(catch 'next
		  (setq c (car chars) chars (cdr chars))
		  (if (string= c last) (throw 'next nil))
		  (setq last c)
		  (setq c (eelll-stroke-for-char c))
		  (if (and c
			   (eq eelll-first-hand
			       (tcode-key-address-right-p (car c)))
			   (eq eelll-second-hand
			       (tcode-key-address-right-p (car (cdr c)))))
		      (progn
			(if (or (< (car c) 10) (< (car (cdr c)) 10))
			    (setq upper t))
			(insert last)))))
	      (insert "\n")
	      (if upper
		  (progn
		    (goto-char (point-min))
		    (end-of-line 1)
		    (or (= (preceding-char) ?!)
			(insert "!"))))
	      (sit-for 0)
	      (if (input-pending-p) (ding)))))
      (message "Compilation end."))))

;;; eelll.el ends here