
#| habuki-mode lapse009 for xyzzy-0.2.2.235 or over version

 Copyright (C) 2007-2008 knenet
 All rights reserved.
 <kneneglect_std@yahoo.co.jp>

娍捈乽彫僲栚乮偼傇偒乯乿傪儅僀僫乕儌乕僪偱巊偆丅
僩儗乕僫乕丄攝楍堦棗婡擻晅偒丅

埲壓偺俀偮偺僼傽僀儖偵暘偗傜傟偰偄傞丅
habuki.l:丂丂丂 杮懱丅
habuki-board.l: 攝抲堦棗昞傪嶌惉丅

愢柧

弨旛
habuki.l傪site-lisp壓偵抲偒丄僶僀僩僐儞僷僀儖偡傞丅
椺偊偽丄.xyzzy偵埲壓傪捛壛偡傞丅
(require "habuki")
(global-set-key #\C-2 'habuki-mode)
(setq *habuki-normal-rule* '("~/habuki.rl" "~/habuki-kanji.rl")
      *habuki-abbrev-rule* "~/habuki-abbrev.rule")
晅懏偺habuki.rl habuki-kanji.rl 傪xyzzy.exe偲摨偠僨傿儗僋僩儕偵抲偔丅

巊偄曽

巊偄偨偄僶僢僼傽偱habuki-mode傪婲摦偡傞丅
qwerty攝楍偵懳偟偰丄嵍恖嵎偟巜傪G丄塃恖嵎偟巜傪K偺埵抲偵忔偣傞丅
揔摉偵僉乕傪扏偔偲暥帤偑弌傞丅
Q 仺僿儖僾偑弌傞丅 ~ 仺婡擻堦棗傒偨偄偺丅

攝楍偺徻嵶偼屻擔丄暿僼傽僀儖偵偰愢柧偡傞乧乧偐傕丅

 棜楌

lapse001 2007-02-26 10:25 偲傝偁偊偢姰惉丅
lapse002 2007-03-28 02:41 傂偲偲偍傝挷惍丅
lapse003 2008-02-26 22:05 彫僲栚偵柤徧曄峏丅帿彂偲斣崋傪暘偗傞丅
lapse004 2008-02-28 23:34 僴僢僔儏傪柍懯偵巊偆偺傪巭傔偨丅
lapse005 2008-03-03 23:00 overwrite-mode偺巊偄摴偑暘偐偭偨丅
lapse006 2008-03-05 18:08 abbrev婡擻偲斦柺弌椡婡擻乮暿僼傽僀儖乯傪晅偗偨丅
lapse007 2008-03-08 20:35 搊榐岅偲儊儌偺昞帵婡擻傪晅偗偨丅
lapse008 2008-03-10 00:27 僊儕僔儍帤偺戝暥帤彫暥帤曄姺丅
lapse009 2008-03-11 19:32 habuki-count-toggle偲偐habuki-test-region偲偐丅

 尃棙丒愑擟娭學

擔杮崙偺挊嶌尃朄偑揔梡偝傟傞斖埻偱knenet偑挊嶌尃傪帩偮丅
嵶偐偔尒傞偲丄偳偙偵傕庡挘偡傞傋偒揰偑側偝偦偆偩偗傟偳傕丅
儔僀僙儞僗偼埲壓偺捠傝丅MIT License偲摨摍偱偁傞偲峫偊偰椙偄丅

攝晍丄夵憿丄曇嶽摍偺嵞棙梡傪嫋壜偡傞丅擇師憂嶌暔偺尃棙偼堦愗庡挘偟側偄乮偟摼側偄乯丅
偨偩偟丄僼傽僀儖偺僶乕僕儑儞傗嶌惉丒攝晍尦偑嬫暿偱偒傞傛偆偵柤慜傗昞帵傪峫椂偡傞偙偲丅
屻偵忣曬尦偑偨偳傟傞傛偆偵丄挊嶌尃昞帵傪柧婰偡傞偙偲丅
壗恖傕丄偙偺僾儘僌儔儉偵傛偭偰惗偠偨懝塿偵偮偄偰愑擟傪帩偨側偄丅
偙偺僾儘僌儔儉傪巊梡偡傞幰偼丄摨帪偵偙偺儔僀僙儞僗傪嫋戻偟偰偄傞傕偺偲傒側偡丅

偊傫偄乕 |#

;仠仠charm仠仠

(provide "habuki")

(defpackage "habuki" (:use "lisp"))
(use-package "habuki")
(in-package "habuki")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "habuki")
  (use-package "editor"))

(export
 '(*habuki-mode*
   *habuki-mode-hook*
   *habuki-input*
   *habuki-num-convert*
   *habuki-rule-table*
   *habuki-anti-rule-table*
   *habuki-help-table*
   *habuki-convert-table*
   *habuki-abbrev-rule-list*
   *habuki-normal-rule*
   *habuki-abbrev-rule*
   *habuki-cur-root-name*
   *habuki-help-on*
   *habuki-help-word*
   *habuki-help-after-num*
   *habuki-help-before-num*
   *habuki-help-keyboard-on*
   *habuki-habuki-output-method*
   *habuki-count-on*
   *habuki-count-start*
   *habuki-count*
   habuki-mode
   habuki-help-on
   habuki-help-off
   habuki-set-normal-rule
   habuki-set-habuki-rule
   habuki-save-rule
   habuki-set-help-after-num
   habuki-set-help-before-num
   habuki-help-keyboard-toggle
   habuki-help-toggle
   habuki-convert
   habuki-set-help-after-num
   habuki-set-help-before-num
   habuki-input-abbrev
   habuki-set-abbrev-rule
   habuki-help-set-default
   habuki-forward-char
   habuki-next-virtual-line
   habuki-previous-virtual-line
   habuki-backward-char
   habuki-newline
   habuki-delete-backward-char-or-selection
   habuki-delete-char
   habuki-undo
   habuki-redo
   habuki-write-fullsize-space
   habuki-write-glass
   habuki-show-memo
   habuki-show-abbrev
   habuki-count-toggle
   habuki-count-appeal
   habuki-test-region))

;仠仠variables仠仠

(defvar-local *habuki-mode* nil)
(defvar *habuki-mode-hook* nil)
(defvar *habuki-memo*
  '("!倶倣倛倐乮乤乯倖們倢丟| |  1-7:徣弌椡乛昞帵 0:徣昞帵偺儕僙僢僩 9:徣昞帵堦棗 ?:徣昞帵 q:徣弌椡"
    "倷俆侾俀倓丠亅倵係俈俉仮||  =:徣搊榐 ,.:傾儞僪僁儕僪僁 m:夵峴 -:僇僂儞僩 /:婯懃昡壙 w:憪"
    "劔倞丆丏侽俇俋俁乛丱亖劔?|  PNBF:忋壓嵍塃 J:慡妏僗儁乕僗 d:嶍彍 h:屻戅 ;:偙偺儊儌傪昞帵 "
    " 劒劒劒倸倠伿倫仩劒劒劒丂|  C-2:廔椆 x:斦柺昞帵愗傝懼偊 h:僿儖僾昞帵愗傝懼偊"))

(defvar *habuki-rule-table* nil)
(defvar *habuki-anti-rule-table* nil)
(defvar *habuki-abbrev-rule-list* nil)

(defvar *habuki-normal-rule* nil)
(defvar *habuki-abbrev-rule* nil)

(defvar *habuki-help-on* nil)
(defvar *habuki-help-table* nil)
(defvar *habuki-help-after-num* 2)
(defvar *habuki-help-before-num* 1)
(defvar *habuki-help-keyboard-on* t)
(defvar *habuki-help-word* "")
(defvar *habuki-abbrev-output-method* nil)

(defvar *habuki-cur-root-name* "")
(defvar *habuki-input* nil)
(defvar *habuki-num-convert* "GERKOWHP`J")
(setq habuki-num (map 'list 'cons *habuki-num-convert* '(0 1 2 3 4 5 6 7 8 9)))

(setq habuki-all-char (coerce "1234567890-^\\qwertyuiop@[asdfghjkl;:]zxcvbnm,./" 'list))
(defvar *habuki-lone-char* (coerce "17\\a]ncxz./" 'list))
(setq habuki-char (set-difference habuki-all-char *habuki-lone-char*))
(setq habuki-read-root-name "")
(setq habuki-help-buff-name "*彫僲栚僿儖僾*")

(defvar *habuki-count-on* nil)
(defvar *habuki-count-start* nil)
(defvar *habuki-count* 0)
(defvar *habuki-test-left-char* "23456qwertysdfghvb")
(defvar *habuki-test-home-char* "wergkop@")

(defvar *habuki-mode-map* nil)
(unless *habuki-mode-map*
  (setq *habuki-mode-map* (make-keymap))
  (dolist (c habuki-all-char)
    (define-key *habuki-mode-map* c 'habuki-input))
  (dolist (c (coerce (substring *habuki-num-convert* 1 8) 'list))
    (define-key *habuki-mode-map* c 'habuki-input-abbrev))
  (define-key *habuki-mode-map* #\Q 'habuki-help-toggle)
  (define-key *habuki-mode-map* #\" 'habuki-help-keyboard-toggle)
  (define-key *habuki-mode-map* #\V 'habuki-set-help-before-num)
  (define-key *habuki-mode-map* #\< 'habuki-set-help-after-num)
  (define-key *habuki-mode-map* #\) 'habuki-forward-char)
  (define-key *habuki-mode-map* #\% 'habuki-backward-char)
  (define-key *habuki-mode-map* #\` 'habuki-next-virtual-line)
  (define-key *habuki-mode-map* #\M 'habuki-previous-virtual-line)
  (define-key *habuki-mode-map* #\# 'habuki-newline)
  (define-key *habuki-mode-map* #\$ 'habuki-delete-backward-char-or-selection)
  (define-key *habuki-mode-map* #\T 'habuki-delete-char)
  (define-key *habuki-mode-map* #\D 'habuki-undo)
  (define-key *habuki-mode-map* #\F 'habuki-redo)
  (define-key *habuki-mode-map* #\S 'habuki-write-fullsize-space)
  (define-key *habuki-mode-map* #\I 'habuki-write-glass)
  (define-key *habuki-mode-map* #\G 'habuki-help-set-default)
  (define-key *habuki-mode-map* #\+ 'habuki-coerce-output)
  (define-key *habuki-mode-map* #\Y 'habuki-coerce-show)
  (define-key *habuki-mode-map* #\* 'habuki-set-abbrev-rule)
  (define-key *habuki-mode-map* #\~ 'habuki-show-memo)
  (define-key *habuki-mode-map* #\J 'habuki-show-abbrev)
  (define-key *habuki-mode-map* #\U 'habuki-count-toggle)
  (define-key *habuki-mode-map* #\L 'habuki-test-region)
  )
(pushnew '(*habuki-mode* . "徣") *minor-mode-alist* :key #'car)

;仠仠mode functions仠仠

(defun habuki-version ()
  (interactive)
  (and (interactive-p)
       (message "彫僲栚 lapse ~A in 2008-03-11" (habuki-version)))
  "009")

(defun habuki-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode '*habuki-mode* arg sv)
  (update-mode-line t)
  (if *habuki-mode*
      (progn
	(or *habuki-rule-table*
	    (habuki-set-rule))
	(or *habuki-abbrev-rule-list*
	    (habuki-read-abbrev-rule-file *habuki-abbrev-rule*))
	(setq *habuki-cur-root-name* "" *habuki-input* "")
	(set-minor-mode-map *habuki-mode-map*)
	(and *habuki-help-on*
	     (habuki-help-activate)
	     (habuki-help))
	(run-hooks '*habuki-mode-hook*))
    (progn
      (unset-minor-mode-map *habuki-mode-map*)
      (habuki-help-kill)
      (when *habuki-count-on* (habuki-count-off))))
    t)

(defvar *habuki-convert-table* nil)
(unless *habuki-convert-table*
  (setq *habuki-convert-table* (make-hash-table :size 499 :test 'equal))
  (map nil #'(lambda (x y)
	       (setf (gethash x *habuki-convert-table*) y)
	       (setf (gethash y *habuki-convert-table*) x))
       (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ.,-!':俙俛俠俢俤俥俧俫俬俰俲俴俵俶俷俹俻俼俽俿倀倁倂倃倄倅丏丆亅両乫丗"
	       "儫儬儭儮儯儰儱儲儳儴儵儶儷儸儹儺儺儻儼儾兂兇兊兌")
       (concat "abcdefghijklmnopqrstuvwxyz*=+?`;倎倐們倓倕倖倗倛倝倞倠倢倣値倧倫倯倰倱倲倳倴倵倶倷倸仏亖亄丠乪丟"
	       "兛兝兞兟兠兡兣兤兦內兩兪兯兲兺兾兿冃冄円冇冊冋冎")))

(defun habuki-set-rule ()
  (long-operation
    (setq *habuki-rule-table* (make-hash-table :size 4999 :test 'equal)
	  *habuki-anti-rule-table* (make-hash-table :size 4999 :test 'equal))
    (mapc #'habuki-read-rule-file *habuki-normal-rule*)
    (message "婯懃傪撉傒崬傫偩丅")))

(defun habuki-read-rule-file (file)
  (when (and file
	     (file-exist-p file))
    (with-open-file (in file :direction :input)
      (message "~A 傪撉傒崬傫偱傞偲偙傠丅" file)
      (let (buff from to)
	(while (setq buff (read-line in nil))
	  (setq buff (string-trim " \t" buff))
	  (or (string-match "^%" buff)
	      (and (string-match "^#s" buff)
		   (setq from (1+ (string-match "\"" buff)))
		   (setq to (string-match "\"" buff from))
		   (setq habuki-read-root-name (substring buff from to)))
	      (and (setq to (string-match ">" buff))
		   (habuki-push-word (substring buff 0 to) (substring buff (1+ to)) habuki-read-root-name))
	      ))))))

(defun habuki-read-abbrev-rule-file (file)
  (when (and file
	     (file-exist-p file))
    (with-open-file (in file :direction :input)
      (message "~A 傪撉傒崬傫偱傞偲偙傠丅" file)
      (let (buff)
	(while (setq buff (read-line in nil))
	  (push (cons (char-into-num (elt buff 0)) (substring buff 1)) *habuki-abbrev-rule-list*))))
    (message "婯懃傪撉傒崬傫偩丅")))

(setq char-into-num (map 'list 'cons "0123456789" '(0 1 2 3 4 5 6 7 8 9)))
(defun char-into-num (c)
  (cdr (assoc c char-into-num)))

(defun habuki-push-word (key word root-name)
  (and (> (length key) 0)
       (> (length word) 0)
       (setf (gethash (list root-name key) *habuki-rule-table*) word)
       (setf (gethash (char word 0) *habuki-anti-rule-table*) (list root-name key))
       ))

(defun habuki-input ()
  (interactive "*")
  (and *habuki-count-on* *habuki-count-start* (habuki-count-appeal))
  (let ((s (habuki-input-sub *last-command-char*)))
    (when (stringp s)
      (habuki-output s))
    (habuki-help)))

(defun habuki-output (s)
  (when *habuki-count-on*
    (setq *habuki-count* (+ *habuki-count* (length s)))
    (unless *habuki-count-start*
      (setq *habuki-count-start* (get-internal-real-time))))
  (if overwrite-mode
      (mapcar #'overwrite-char (coerce s 'list))
    (insert s))
  (when (not (equal *habuki-help-word* ""))
    (setq *habuki-help-word*
	  (if (< (length s) (length *habuki-help-word*))
	      (substring *habuki-help-word* (length s))
	  ""))))

;#p:prefix #s "":switch to "" ##:insert # #c convert
(defun habuki-input-sub (c)
  (or (and (find c *habuki-lone-char*)
	   (setq c (string c)))
      (setq c (concat *habuki-input* (string c))))
  (setq *habuki-input* "")
  (let ((word (gethash (list *habuki-cur-root-name* c) *habuki-rule-table*)))
    (or (null word)
	(when (string-match "^#p" word) (setq *habuki-input* c) t)
	(when (string-match "^#c" word) (habuki-convert) t)
	(when (string-match "^##" word) "#")
	(when (string-match "^#s" word)
	     (let* ((from (1+ (string-match "\"" word)))
		    (to (string-match "\"" word from)))
	       (setq *habuki-cur-root-name* (substring word from to))
	       t))
	word)))

;仠仠help function仠仠

(defun habuki-help ()
  (if (not (equal *habuki-help-word* ""))
      (save-excursion
	(erase-buffer (switch-to-buffer habuki-help-buff-name))
	(insert "\n\n\n")
	(when *habuki-help-keyboard-on*
	  (habuki-help-push (habuki-help-keyboard *habuki-input*)))
	(dolist (c (coerce *habuki-help-word* 'list))
	  (habuki-help-push (habuki-help-char c))))
    (when *habuki-help-on*
      (let ((s (buffer-substring (- (point) *habuki-help-before-num*)
				 (+ (point) *habuki-help-after-num*))))
	(save-excursion
	  (erase-buffer (switch-to-buffer habuki-help-buff-name))
	  (insert "\n\n\n")
	  (when *habuki-help-keyboard-on*
	    (habuki-help-push (habuki-help-keyboard *habuki-input*)))
	  (dolist (c (coerce s 'list))
	    (habuki-help-push (habuki-help-char c)))))))
  (when (and (not *habuki-help-on*)
	     (equal *habuki-help-word* ""))
    (habuki-help-kill))
  (unless *habuki-count-on* (message *habuki-input*)))

(defun habuki-help-on ()
  (setq *habuki-help-on* t)
  (habuki-help-activate)
  (habuki-help))

(defun habuki-help-off ()
  (setq *habuki-help-on* nil)
  (habuki-help-kill))

(defun habuki-help-kill ()
  (let ((buff (find-buffer habuki-help-buff-name)))
    (when buff
      (and (get-buffer-window buff)
	   (delete-window))
      (kill-buffer buff))))

(defun habuki-help-activate ()
  (with-selected-window
    (pop-to-buffer (get-buffer-create habuki-help-buff-name) -4)
    (set-buffer-fold-width nil)
    (set-local-window-flags (selected-buffer) *window-flag-half-width-space* nil)
    (set-local-window-flags (selected-buffer) *window-flag-eof* nil)
    (set-local-window-flags (selected-buffer) *window-flag-fold-mark* nil)
    (set-local-window-flags (selected-buffer) *window-flag-eof* nil)
    (set-local-window-flags (selected-buffer) *window-flag-hscroll-bar* nil)
    (set-local-window-flags (selected-buffer) *window-flag-mode-line* nil)
    (set-local-window-flags (selected-buffer) *window-flag-vscroll-bar* nil)
    (set-local-window-flags (selected-buffer) *window-flag-newline* nil)
    (make-local-variable 'need-not-save)
    (setq need-not-save t)))

(defun habuki-help-toggle ()
  (interactive)
  (if *habuki-help-on*
      (habuki-help-off)
    (habuki-help-on)))

(defun habuki-help-keyboard-toggle ()
  (interactive)
  (setq *habuki-help-keyboard-on* (not *habuki-help-keyboard-on*))
  (habuki-help))

(defun habuki-help-fundamental ()
  (setq habuki-help-figure
	(list (copy-string "|丂丂丂乚丂乤丂乚丂丂丂| |")
	      (copy-string "丂乚丯丯丂丂丂丂丯丯乚丂||")
	      (copy-string "劔丂丂丂乕丂丂乕丂丂丂劔 |")
	      (copy-string " 劒劒劒丂丂伿丂丂劒劒劒丂|"))))

(setq help-appearance
      (map 'list
	   #'cons
	   (concat "abcdefghijklmnopqrstuvwxyz"
		   "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
		   "1234567890 !\"#$%&'()=~|`{+"
		   "\n*}<>?_-^\\@[;:],./")
	   (concat "倎倐們倓倕倖倗倛倝倞倠倢倣値倧倫倯倰倱倲倳倴倵倶倷倸"
		   "俙俛俠俢俤俥俧俫俬俰俲俴俵俶俷俹俻俼俽俿倀倁倂倃倄倅"
		   "侾俀俁係俆俇俈俉俋侽仩両乭仛亹亾仌乫乮乯亖乣乥乪乷亄"
		   "丂仏乸亙亜丠丵亅丱乢仐乵丟丗乶丆丏乛")))

(setq help-position
      (map 'list
	   #'cons
	   "23456890-^qwertyuiop@[sdfghjkl;:vbm,"
	   '((1 0) (2 0) (3 0) (4 0) (5 0)        (7 0) (8 0) (9 0) (10 0) (11 0)
	     (0 1) (1 1) (2 1) (3 1) (4 1) (5 1)  (6 1) (7 1) (8 1) (9 1) (10 1) (11 1)
	     (1 2) (2 2) (3 2) (4 2) (5 2)        (6 2) (7 2) (8 2) (9 2) (10 2)
	     (4 3) (5 3)  (7 3) (8 3))))

(defun habuki-help-replace (p c)
  (and p c
       (setf (elt (elt habuki-help-figure (second p)) (first p)) c)))

(defun habuki-help-push (str)
  (goto-char 0)
  (end-of-line)
  (dolist (s str)
    (insert s)
    (next-line)))

(defun habuki-help-char (c)
  (habuki-help-fundamental)
  (let* ((arg (gethash c *habuki-anti-rule-table*))
	 (root-name (first arg))
	 (key (second arg)))
    (habuki-help-replace '(6 0) (or (cdr (assoc c help-appearance)) c))
    (and (> (length root-name) 0)
	 (habuki-help-replace '(12 2) (elt root-name 0)))
    (or (not key)
	(when (= (length key) 1)
	  (habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仠))
	(when (= (length key) 2)
	  (or (when (equal (elt key 0) (elt key 1))
		(habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仧))
	      (and (habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仠)
		   (habuki-help-replace (cdr (assoc (char key 1) help-position)) #\仜))))
	(when (= (length key) 3)
	  (or (when (equal (elt key 0) (elt key 1))
		(or (and (equal (elt key 0) (elt key 2))
			 (habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仛))
		    (and (habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仧)
			 (habuki-help-replace (cdr (assoc (char key 2) help-position)) #\仮))))
	      (when (equal (elt key 0) (elt key 2))
		(habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仴)
		(habuki-help-replace (cdr (assoc (char key 1) help-position)) #\仜))
	      (when (equal (elt key 1) (elt key 2))
		(habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仠)
		(habuki-help-replace (cdr (assoc (char key 1) help-position)) #\仦))
	      (when (habuki-help-replace (cdr (assoc (char key 0) help-position)) #\仠)
		(habuki-help-replace (cdr (assoc (char key 1) help-position)) #\仜)
		(habuki-help-replace (cdr (assoc (char key 2) help-position)) #\仮)))))
    habuki-help-figure))

(defun habuki-help-keyboard (input)
  (habuki-help-fundamental)
  (and (> (length *habuki-cur-root-name*) 0)
       (habuki-help-replace '(12 2) (elt *habuki-cur-root-name* 0)))
  (dolist (pos habuki-char)
    (let* ((word (gethash (list *habuki-cur-root-name* (concat input (string pos))) *habuki-rule-table*))
	   (c (elt word 0))
	   (display-char (or (and (null word) #\丂)
			     (and (string-match "^#p" word) #\仩)
			     (and (string-match "^#c" word) #\仮)
			     (and (string-match "^##" word) #\仈)
			     (and (string-match "^#s" word) #\仚)
			     (cdr (assoc c help-appearance))
			     c)))
    (habuki-help-replace (cdr (assoc pos help-position)) display-char)))
  habuki-help-figure)

;仠仠intaractive functions仠仠

(defun habuki-convert ()
  (let ((s (gethash (char (buffer-substring (1- (point)) (point)) 0) *habuki-convert-table*)))
    (and s
	 (backward-char)
	 (overwrite-char s))))

(defun habuki-coerce-show ()
  (interactive)
  (setq *habuki-abbrev-output-method* #\?)
  (message "昞帵偡傞"))

(defun habuki-coerce-output ()
  (interactive)
  (setq *habuki-abbrev-output-method* #\^)
  (message "弌椡偡傞"))

(defun habuki-safe-input-num (&optional (start 0) (end 10))
  (let (x)
  (while (and (not (eq (peek-char *standard-input* ed:*keyboard*) #\C-g))
	      (not (and (setq x (cdr (assoc (read-char ed:*keyboard*) habuki-num)))
			(>= x start)
			(< x end)))))
    x))

(defun habuki-set-help-after-num ()
  (interactive)
  (when *habuki-help-on* (message "屻偺暥帤悢丠"))
  (let ((n (habuki-safe-input-num)))
    (and n
	 (setq *habuki-help-after-num* n)))
  (habuki-help))

(defun habuki-set-help-before-num ()
  (interactive)
  (when *habuki-help-on* (message "慜偺暥帤悢丠"))
  (let ((n (habuki-safe-input-num)))
    (and n
	 (setq *habuki-help-before-num* n)))
  (habuki-help))

(defun habuki-input-abbrev ()
  (interactive "*")
  (let ((s (cdr (assoc (cdr (assoc *last-command-char* habuki-num)) *habuki-abbrev-rule-list*))))
    (if (stringp s)
	(if (or (eq *habuki-abbrev-output-method* #\?)
		(and (eq *habuki-abbrev-output-method* nil)
		     (eq (char s 0) #\?)))
	    (habuki-show-help-word (substring s 1))
	  (habuki-output (substring s 1)))
      (message "側偄傛"))
  (setq *habuki-input* "")
    (habuki-help)))

(defun habuki-show-help-word (s)
  (setq *habuki-help-word* s)
  (unless *habuki-help-on*
    (habuki-help-activate)))

(defun habuki-set-abbrev-rule ()
  (interactive)
  (let* ((n (progn (message "壗暥帤丠") (habuki-safe-input-num)))
	 (sw (let ()
	       (message "~A -> S-^:弌椡偡傞 S-?:昞帵偡傞" n)
	       (while (and (not (eq (peek-char *standard-input* ed:*keyboard*) #\C-g))
			   (not (or (eq (peek-char *standard-input* ed:*keyboard*) #\+)
				    (eq (peek-char *standard-input* ed:*keyboard*) #\Y))))
		 (read-char ed:*keyboard*))
	       (or (and (eq (peek-char *standard-input* ed:*keyboard*) #\+) #\^)
		   (and (eq (peek-char *standard-input* ed:*keyboard*) #\Y) #\?)
		   " ")))
	 (num (progn (message "~A -> 偳偺僉乕丠" sw) (habuki-safe-input-num 1 8)))
	 (s (when n (concat (string sw) (buffer-substring (- (point) n) (point))))))
    (when (and n sw num)
      (push (cons num s) *habuki-abbrev-rule-list*)
      (when *habuki-abbrev-rule*
	(with-open-file (to *habuki-abbrev-rule* :direction :output
			    :if-exists :append :if-does-not-exist :create)
	  (format to "~D~A~%" num s)))
      (message "\"~A\"傪~A斣偵搊榐偟偨丅" s num))))

(defun habuki-help-set-default ()
  (interactive)
  (setq *habuki-abbrev-output-method* nil)
  (setq *habuki-help-word* "")
  (setq *habuki-input* "")
  (habuki-help)
  (message "僨僼僅儖僩"))

(defun habuki-forward-char ()
  (interactive)
  (forward-char)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-next-virtual-line ()
  (interactive)
  (next-virtual-line)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-previous-virtual-line ()
  (interactive)
  (previous-virtual-line)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-backward-char ()
  (interactive)
  (backward-char)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-newline ()
  (interactive)
  (newline)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-delete-backward-char-or-selection ()
  (interactive "*")
  (delete-backward-char-or-selection)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-delete-char ()
  (interactive "*")
  (delete-char)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-undo ()
  (interactive "*")
  (undo)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-redo ()
  (interactive "*")
  (redo)
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-write-fullsize-space ()
  (interactive "*")
  (if overwrite-mode
      (overwrite-char #\丂)
    (insert "丂"))
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-write-glass ()
  (interactive "*")
  (if overwrite-mode
      (overwrite-char #\倵)
    (insert "倵"))
  (setq *habuki-input* "")
  (habuki-help))

(defun habuki-show-memo ()
  (interactive)
  (unless *habuki-help-on*
    (habuki-help-on))
  (save-excursion
    (erase-buffer (switch-to-buffer habuki-help-buff-name))
    (insert "\n\n\n")
    (habuki-help-push *habuki-memo*)))

(defun habuki-show-abbrev ()
  (interactive)
  (unless *habuki-help-on*
    (habuki-help-activate))
  (save-excursion
    (erase-buffer (switch-to-buffer habuki-help-buff-name))
    (insert "\n\n\n")
    (habuki-help-push (list (concat "1 " (cdr (assoc 1 *habuki-abbrev-rule-list*))
				    "  2 " (cdr (assoc 2 *habuki-abbrev-rule-list*)))
			    (concat "3 " (cdr (assoc 3 *habuki-abbrev-rule-list*))
				    "  4 " (cdr (assoc 4 *habuki-abbrev-rule-list*)))
			    (concat "5 " (cdr (assoc 5 *habuki-abbrev-rule-list*))
				    "  6 " (cdr (assoc 6 *habuki-abbrev-rule-list*)))
			    (concat "7 " (cdr (assoc 7 *habuki-abbrev-rule-list*))
				    "  ^:弌椡  ?:昞帵")))))


(defun habuki-count-toggle ()
  (interactive)
  (defun on ()
    (setq *habuki-count-on* (message "僇僂儞僩丄擖椡懸偪..")
	  *habuki-count-start* nil
	  *habuki-count* 0)
    (set-mark (point))
    (start-timer 1.0 'habuki-count-appeal))
  (if *habuki-count-on*
      (habuki-count-off)
    (on)))

(defun habuki-count-off ()
  (stop-timer 'habuki-count-appeal)
  (habuki-count-appeal)
  (setq *habuki-count-on* nil))

(defun habuki-count-appeal ()
      (let ((sec (/ (- (get-internal-real-time) *habuki-count-start*) internal-time-units-per-second)))
	(message "~D 帤 / ~D 昩 (~4F)" *habuki-count* (round sec) (/ *habuki-count* sec))))

(defun habuki-test-region (from to)
  (interactive "r")
  (let ((str (buffer-substring (if (< from to) from to) (if (> from to) from to)))
	(valid-strlen 0) (stroke 0) (left 0) (right 0) (alternate 0) (home 0) (root-change -1) l r)
    (when (< 0 (length str))
      (long-operation
	(dolist (x (coerce str 'list))
	  (let* ((arg (gethash x *habuki-anti-rule-table*))
		 (root-name (first arg))
		 (key (second arg)))
	    (when arg
	      (setq valid-strlen (1+ valid-strlen))
	      (unless (eq r root-name)
		(setq r root-name
		      root-change (1+ root-change)))
	      (map nil #'(lambda (c) (push c l)) key))))
	(when (< 0 (setq stroke (length (setq l (reverse l)))))
	  (map nil #'(lambda (x y)
		       (when (find x *habuki-test-home-char*)
			 (setq home (1+ home)))
		       (or (and (find x *habuki-test-left-char*) (setq left (1+ left))
				(find y *habuki-test-left-char*))
			   (and (not (find x *habuki-test-left-char*)) (setq right (1+ right))
				(not (find y *habuki-test-left-char*)))
			   (setq alternate (1+ alternate))))
	       l (cdr l))
	  (let ((x (car (reverse l))))
	    (message "~A" x)
	    (if (find x *habuki-test-left-char*)
		(setq left (1+ left))
	      (setq right (1+ right)))
	    (if (find x *habuki-test-home-char*)
		(setq home (1+ home))))
	  (unless *habuki-help-on*
	    (habuki-help-activate))
	  (save-excursion
	    (erase-buffer (switch-to-buffer habuki-help-buff-name))
	    (insert "\n\n\n")
	    (habuki-help-push (list
			       (format nil "桳岠暥帤悢: ~A 帤 乛 憤崌懪尞悢: ~A(~A) 懪" valid-strlen stroke (+ stroke root-change))
			       (format nil "嵍懪尞悢: ~A 懪  儖乕僩曄峏: ~A 夞  岎屳懪尞斾棪: ~4F%" left root-change (/ alternate (1- stroke) 0.01))
			       (format nil "塃懪尞悢: ~A 懪  儕乕僕儑儞: ~A 帤  儂乕儉巊梡斾棪: ~4F%" right (length str) (/ home stroke 0.01))
			       (format nil "嵍塃斾棪 ~4F% / ~4F% 1帤摉偨傝暯嬒懪尞悢 ~5F(~5F) 懪" (/ left stroke 0.01) (/ right stroke 0.01) (/ stroke valid-strlen 1.0) (/ (+ stroke root-change) valid-strlen 1.0))))))))))


