(defvar egg-default-language "Japanese")
(defvar egg-last-method-name)
(make-variable-buffer-local 'egg-last-method-name)
-(defvar egg-mode-line-title)
-(make-variable-buffer-local 'egg-mode-line-title)
;;;###autoload
(defun egg-mode (&rest arg)
(egg-exit-conversion)))
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
- (let ((orig-local-map (keymap-parent (current-local-map))))
- (use-local-map orig-local-map))
- (run-hooks 'input-method-inactivate-hook))
+ (use-local-map (keymap-parent (current-local-map)))
+ (force-mode-line-update))
;; Turn on
(if (null (string= (car arg) egg-last-method-name))
(progn
(funcall (nth 1 arg))
- (setq egg-default-language its-current-language)))
+ (setq egg-default-language its-current-language)))
(setq egg-last-method-name (car arg))
(use-local-map (if egg-mode-preference
(egg-modefull-map)
(egg-modeless-map)))
(setq inactivate-current-input-method-function 'egg-mode)
(setq describe-current-input-method-function 'egg-help)
- (run-hooks 'input-method-activate-hook))
- (force-mode-line-update))
+ (add-hook 'input-method-activate-hook 'egg-set-mode-line-title)))
-(defun egg-set-mode-line-title (title)
- (setq egg-mode-line-title title)
+(defun egg-set-mode-line-title ()
+ (setq current-input-method-title (its-get-indicator its-current-map))
(force-mode-line-update))
(defun egg-check-language (lang)
(while (< i 127)
(define-key map (vector i) 'egg-self-insert-char)
(setq i (1+ i)))
+ (its-define-select-keys map)
(set-keymap-parent map (current-local-map))
map))
(defvar its-zhuyin nil)
(make-variable-buffer-local 'its-zhuyin)
-(defmacro its-make-slect-func (key name file map &optional lang zhuyin)
+(defun its-make-select-func (key name file map &optional lang zhuyin)
(setq name (intern (concat "its-select-" (symbol-name name)))
file (intern (concat "its/" (symbol-name file)))
map (intern (concat "its-" (symbol-name map) "-map"))
lang (symbol-name lang))
- `(progn
- (defun ,name ()
- (interactive)
- (cond
- ((its-in-fence-p)
- (its-input-end)
- (its-put-cursor t))
- ((egg-get-bunsetsu-info (point))
- (egg-exit-conversion)))
- ,(if lang `(egg-check-language ,lang))
- (require ',file)
- (setq its-current-map ,map)
- ,(if lang `(setq its-current-language ,lang))
- ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T)))
- (egg-set-mode-line-title (its-get-indicator its-current-map)))
- (define-key mule-keymap ,key ',name)))
+ (cons
+ `(defun ,name (&optional mode-line-unchange)
+ (interactive)
+ (cond
+ ((its-in-fence-p)
+ (its-input-end)
+ (its-put-cursor t))
+ ((egg-get-bunsetsu-info (point))
+ (egg-exit-conversion)))
+ ,(if lang `(egg-check-language ,lang))
+ (require ',file)
+ (setq its-current-map ,map)
+ ,(if lang `(setq its-current-language ,lang))
+ ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T)))
+ (if (null mode-line-unchange)
+ (egg-set-mode-line-title)))
+ `(define-key map ,(concat "\C-x\C-m" key) ',name)))
-(defmacro its-do-list-make-slect-func (list)
+(defmacro its-do-list-make-select-func (list)
(eval-when (eval compile)
- (let (e l)
+ (let (funcs keydefs pair)
(while list
- (setq e (car list))
- (setq l (cons `(its-make-slect-func ,@(car list)) l))
+ (setq pair (apply 'its-make-select-func (car list)))
+ (setq funcs (cons (car pair) funcs)
+ keydefs (cons (cdr pair) keydefs))
(setq list (cdr list)))
- (cons 'progn l))))
+ `(progn
+ ,@funcs
+ (defun its-define-select-keys (map)
+ ,@keydefs)))))
-(its-do-list-make-slect-func
+(its-do-list-make-select-func
(("Q" upcase ascii up)
("q" downcase ascii down)
("h" hiragana hira hira Japanese)
("P" pinyin-tw pinyin pinyin-tw Chinese-CNS NIL)
("Z" zhuyin-tw zhuyin zhuyin-tw Chinese-CNS T)
("U" quanjiao-upcase-tw quanjiao quanjiao-up-tw Chinese-CNS)
- ("D" quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS)
+ ("C" quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS)
("H" hangul hangul hangul Korean)
("J" jeonkak-upcase jeonkak jeonkak-up Korean)
("j" jeonkak-downcase jeonkak jeonkak-down Korean)))
(defvar its-fence-close "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
(defvar its-fence-face nil "*\e$B%U%'%s%9I=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
+(defconst its-setup-fence-before-insert-SYL nil)
+
(defun its-put-cursor (cursor)
(let ((p (point)))
(insert "!")
'intangible 'its-part-2
'its-cursor cursor))
(goto-char p)))
+
+(defsubst its-set-cursor-status (cursor)
+ (put-text-property (point) (1+ (point)) 'its-cursor cursor)
+ cursor)
+
;;
;; +-- START property
;; | --- CURSOR Property
;; intangible intangible
;; 1 2
;;
-(defun its-insert-fence-open ()
- (let ((p (point)))
+(defun its-setup-fence-mode ()
+ (let ((open-props '(its-start t intangible its-part-1))
+ (close-props '(its-end t intangible its-part-2))
+ (p (point)) p1)
(insert its-fence-open)
- (add-text-properties p (point)
- (if its-fence-face
- '(invisible t its-start t intangible its-part-1)
- '(its-start t intangible its-part-1)))))
-
-(defun its-insert-fence-close ()
- (let ((p (point)))
+ (setq p1 (point))
+ (add-text-properties p p1 open-props)
(insert its-fence-close)
- (add-text-properties p (point)
- (if its-fence-face
- '(invisible t its-end t intangible its-part-2)
- '(its-end t intangible its-part-2)))
- (goto-char p)))
+ (add-text-properties p1 (point) close-props)
+ (if its-fence-face
+ (put-text-property 'invisible t p (point)))
+ (goto-char p1)
+ (its-put-cursor t)))
(defun its-start (key)
- (its-insert-fence-open)
- (its-insert-fence-close)
- (its-put-cursor (its-input nil key))
- (force-mode-line-update))
+ (let ((its-setup-fence-before-insert-SYL t))
+ (its-input nil key)
+ (force-mode-line-update)))
(defun its-restart (str)
(let (p)
- (its-insert-fence-open)
- (its-insert-fence-close)
+ (its-setup-fence-mode t)
(setq p (point))
(insert str)
- (put-text-property p (point) 'intangible 'its-part-2)
- (goto-char p)
- (its-put-cursor t)))
+ (its-beginning-of-input-buffer)))
(defun its-self-insert-char ()
(interactive)
(let ((key last-command-char)
- (cursor (get-text-property (point) 'its-cursor))
(syl nil))
- (if (null cursor)
+ (if (null (get-text-property (point) 'its-cursor))
(setq syl (get-text-property (1- (point)) 'its-syl)))
- ;; delete cursor
- (delete-region (point) (1+ (point)))
- (setq cursor (its-input syl key))
- (its-put-cursor cursor)))
+ (its-input syl key)))
(defvar its-current-map nil)
(make-variable-buffer-local 'its-current-map)
(let ((len (length output)))
(if (= len point)
;; point is at end of VSYL. Don't need to call state machine.
- (progn
- (its-buffer-ins/del-SYL
- (its-make-VSYL (concat output (vector key))) syl)
- nil)
+ (its-buffer-ins/del-SYL
+ (its-make-VSYL (concat output (vector key))) syl nil)
;; point is at middle of VSYL.
(let ((new-keyseq (concat (substring output 0 point)
(vector key)
(defvar its-barf-on-invalid-keyseq nil
"T means don't allow invalid key sequence in input buffer.")
+
+(defun its-input-error ()
+ (error "Invalid Romaji Sequence"))
+
\f
;;;
;;; ITS State Machine
;; Return CURSOR
(defun its-state-machine (state key emit)
(let ((next-state (its-get-next-state state key))
- expr-output-back)
- (if next-state
- (let ((kst/t (its-get-kst/t next-state)))
- (funcall emit next-state state)
- (if (not (its-kst-p kst/t))
- ;; Here we arrive to a terminal state.
- ;; Emit a DSYL, and go ahead.
- (let ((output (its-get-output next-state))
- (keyseq (its-get-keyseq next-state))
- (back kst/t))
- (if back
- ;; It's negative integer which specifies how many
- ;; characters we go backwards
- (its-state-machine-keyseq (substring keyseq back)
- emit (< key 0))
- 'its-cursor))
- ;; Still, it's a intermediate state.
- nil))
- (if (and (>= key 0)
- (setq expr-output-back (its-get-otherwise state key)))
- (let ((keyseq (concat (its-get-keyseq state) (char-to-string key))))
- (funcall emit expr-output-back state)
- (its-state-machine-keyseq
- (substring keyseq (its-eob-back expr-output-back)) emit))
- ;; No next state for KEY. It's invalid sequence.
- (if (< key 0) ; no next state for END of keystroke
- ;; ISYL --> DSYL XXX
- (if its-barf-on-invalid-keyseq
- (error its-barf-on-invalid-keyseq)
- (funcall emit (cons (car state)
- (list (its-get-keyseq state))) state)
- t)
- (if its-barf-on-invalid-keyseq
- (error its-barf-on-invalid-keyseq)
- ;; XXX Should make DSYL (instead of VSYL)?
- (let ((keyseq (concat (its-get-keyseq state) (vector key))))
- (funcall emit (its-make-VSYL keyseq) state)
- nil)))))))
+ expr-output-back kst/t output keyseq back)
+ (cond
+ ;; proceed to next status
+ (next-state
+ (setq kst/t (its-get-kst/t next-state)
+ output (its-get-output next-state)
+ keyseq (its-get-keyseq next-state))
+ (cond
+ ;; Still, it's a intermediate state.
+ ((its-kst-p kst/t)
+ (funcall emit next-state state nil))
+
+ ;; It's negative integer which specifies how many
+ ;; characters we go backwards
+ (kst/t
+ (funcall emit next-state state 'its-cursor)
+ (its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
+
+ ;; Here we arrive to a terminal state.
+ ;; Emit a DSYL, and go ahead.
+ (t
+ (funcall emit next-state state 'its-cursor))))
+
+ ;; push back by otherwise status
+ ((and (>= key 0)
+ (setq expr-output-back (its-get-otherwise state key)))
+ (setq keyseq (concat (its-get-keyseq state) (vector key)))
+ (funcall emit expr-output-back state t)
+ (its-state-machine-keyseq
+ (substring keyseq (its-eob-back expr-output-back)) emit))
+
+ ;; No next state for KEY. It's invalid sequence.
+ (its-barf-on-invalid-keyseq
+ (its-input-error))
+
+ ;; no next state for END of keystroke
+ ((< key 0)
+ ;; ISYL --> DSYL XXX
+ (funcall emit (cons (car state)
+ (list (its-get-keyseq state))) state t))
+ (t
+ ;; XXX Should make DSYL (instead of VSYL)?
+ (setq keyseq (concat (its-get-keyseq state) (vector key)))
+ (funcall emit (its-make-VSYL keyseq) state nil)))))
(defvar its-latest-SYL nil
"The latest SYL inserted.")
(syl (its-initial-ISYL))
cursor)
(while (< i len)
- (let ((key (aref keyseq i)))
- (setq cursor
- (if (numberp (cdr syl)) ; VSYL
- (progn
- (funcall emit
- (its-make-VSYL (concat (car syl) (vector key)))
- syl)
- nil)
- (its-state-machine syl key emit)))
- (setq i (1+ i))
- (if cursor
- (setq syl (its-initial-ISYL))
- (setq syl its-latest-SYL))))
+ (cond
+ ((numberp (cdr syl))
+ ;; VSYL - no need looping
+ (funcall emit (its-make-VSYL (concat (car syl) keyseq)) syl nil)
+ (setq cursor nil
+ i len))
+ (t
+ (setq cursor (its-state-machine syl (aref keyseq i) emit))))
+ (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
+ i (1+ i)))
(if eol
(its-state-machine syl -1 emit)
cursor)))
-(defun its-buffer-ins/del-SYL (newsyl oldsyl)
+(defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
+ (if its-setup-fence-before-insert-SYL
+ (progn
+ (setq its-setup-fence-before-insert-SYL nil)
+ (its-setup-fence-mode)))
(its-buffer-delete-SYL oldsyl)
(its-update-latest-SYL newsyl)
(let ((p (point)))
'its-lang its-current-language
'intangible 'its-part-1))
(if its-fence-face
- (put-text-property p (point) 'face its-fence-face))))
+ (put-text-property p (point) 'face its-fence-face))
+ (its-set-cursor-status cursor)))
(defun its-buffer-delete-SYL (syl)
(let ((len (length (its-get-output syl))))
\f
(defvar its-translation-result "" "")
-(defun its-ins/del-SYL-batch (newsyl oldsyl)
+(defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
(its-update-latest-SYL newsyl)
(if (and newsyl
(consp (cdr newsyl))
(setq its-translation-result (concat its-translation-result output))
(put-text-property oldlen (length its-translation-result)
'its-lang its-current-language
- its-translation-result))))
+ its-translation-result)))
+ cursor)
(defun its-translate-region (start end)
(interactive "r")
(let ((i 0)
(syl (its-initial-ISYL))
;; temporally enable DING
- (its-barf-on-invalid-keyseq "Invalid Romaji Sequence")
+ (its-barf-on-invalid-keyseq t)
cursor)
(while (< (point) end)
(let ((key (following-char)))
projects / elisp / egg.git / commitdiff