(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 / blobdiff