l)
((numberp l) ; VSYL
(car syl))
+ ((numberp (cdr l))
+ (substring (car l) 0 (cdr l)))
(t
- (car (cdr syl))))))
+ (car l)))))
(defsubst its-eob-keyexpr (eob)
(car (cdr eob)))
(cons class back))
(defsubst its-make-otherwise (output class+back)
(cons output class+back))
+
+(defsubst its-DSYL-with-back-p (syl)
+ (and (consp (cdr syl))
+ (numberp (its-get-kst/t syl))))
+
+(defsubst its-concrete-DSYL-p (syl)
+ (stringp (cdr syl)))
+
+(defsubst its-make-concrete-DSYL (syl)
+ (if (consp (cdr syl))
+ (cons (its-get-output syl) (its-get-keyseq-syl syl))
+ syl))
+
;;
;;
(define-key map "\C-m" 'its-exit-mode) ; RET
(define-key map [return] 'its-exit-mode)
(define-key map "\C-t" 'its-transpose-chars)
+ (define-key map [backspace] 'its-delete-backward-SYL)
(define-key map [delete] 'its-delete-backward-SYL)
+ (define-key map [M-backspace] 'its-delete-backward-SYL-by-keystroke)
+ (define-key map [M-delete] 'its-delete-backward-SYL-by-keystroke)
(define-key map [right] 'its-forward-SYL)
(define-key map [left] 'its-backward-SYL)
(define-key map "\C-\\" 'its-exit-mode-off-input-method)
(defun its-self-insert-char ()
(interactive)
(let ((key last-command-char)
- (syl nil))
- (if (null (get-text-property (point) 'its-cursor))
- (setq syl (get-text-property (1- (point)) 'its-syl)))
+ (cursor (get-text-property (point) 'its-cursor))
+ (syl (get-text-property (1- (point)) 'its-syl)))
+ (cond
+ ((or (eq cursor t)
+ (not (eq (get-text-property (1- (point)) 'its-map) its-current-map)))
+ (put-text-property (- (point) (length (its-get-output syl))) (point)
+ 'its-syl (its-make-concrete-DSYL syl))
+ (setq syl nil))
+ (cursor
+ (setq syl nil)))
(its-input syl key)))
(defvar its-current-map nil)
(defun its-make-VSYL (keyseq)
(cons keyseq (length keyseq)))
+(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"))
+
;; Return CURSOR
(defun its-input (syl key)
(if (null syl)
(setq syl (its-initial-ISYL)))
(let ((output (car syl))
(k/kk/s (cdr syl)))
- (if (numberp k/kk/s)
+ (cond
+ ((numberp k/kk/s)
;; k/kk/s is "point in keyseq"
- (its-input-to-vsyl syl key k/kk/s output)
+ (its-input-to-vsyl syl key k/kk/s output))
+ ((and its-barf-on-invalid-keyseq
+ (null (its-keyseq-acceptable-p (vector key) syl)))
+ ;; signal before altering
+ (its-input-error))
+ (t
;; It's ISYL
- (its-state-machine syl key 'its-buffer-ins/del-SYL))))
+ (its-state-machine syl key 'its-buffer-ins/del-SYL)))))
(defun its-input-to-vsyl (syl key point output)
(if (< key 0)
- t
+ (its-set-cursor-status t)
(let ((len (length output)))
(if (= len point)
;; point is at end of VSYL. Don't need to call state machine.
(vector key)
(substring output point))))
(its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
-
-(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
((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)
+ (funcall emit
+ (cons (its-get-output expr-output-back)
+ (cons keyseq (its-eob-back expr-output-back)))
+ state t)
(its-state-machine-keyseq
(substring keyseq (its-eob-back expr-output-back)) emit))
+ ((eq its-barf-on-invalid-keyseq 'its-keyseq-test)
+ 'its-keyseq-test-failed)
+
;; 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)))
+ (setq keyseq (concat (its-get-keyseq state) (if (> key 0) (vector key))))
(funcall emit (its-make-VSYL keyseq) state nil)))))
(defvar its-latest-SYL nil
(cond
((numberp (cdr syl))
;; VSYL - no need looping
- (funcall emit (its-make-VSYL (concat (car syl) keyseq)) syl nil)
+ (funcall emit
+ (its-make-VSYL (concat (car syl) (substring keyseq i)))
+ 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
+ (if (eq cursor 'its-keyseq-test-failed)
+ (setq i len)
+ (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
+ i (1+ i))))
+ (if (and eol (not (eq cursor 'its-keyseq-test-failed)))
(its-state-machine syl -1 emit)
cursor)))
(setq ebl nil)
(setq ebl (cdr ebl)))))
expr-output-back))
+
+(defun its-keyseq-acceptable-p (keyseq &optional syl eol)
+ (let ((i 0)
+ (len (length keyseq))
+ (its-barf-on-invalid-keyseq 'its-keyseq-test)
+ (its-latest-SYL nil)
+ (emit (lambda (nsyl osyl cursor)
+ (its-update-latest-SYL nsyl)
+ cursor))
+ cursor)
+ (if (null syl)
+ (setq (its-initial-ISYL)))
+ (while (and syl (< i len))
+ (setq cursor (its-state-machine syl (aref keyseq i) emit))
+ (cond
+ ((eq cursor 'its-keyseq-test-failed)
+ (setq syl nil))
+ (cursor
+ (setq syl (its-initial-ISYL)))
+ (t
+ its-latest-SYL))
+ (setq i (1+ i)))
+ (if eol
+ (setq cursor (its-state-machine syl -1 emit)))
+ (not (eq cursor 'its-keyseq-test-failed))))
\f
;;;
;;; Name --> map
(setq syl (get-text-property p 'its-syl))
(setq n (1- n)))
;; Make SYLs have property of "part 1"
- (put-text-property p old-point 'intangible 'its-part-1)
+ (put-text-property old-point p 'intangible 'its-part-1)
(goto-char p)
(its-put-cursor t)
(if (> n 0)
(defvar its-delete-by-keystroke nil)
+(defun its-delete-backward-SYL-by-keystroke (n killflag)
+ (interactive "p\nP")
+ (let ((its-delete-by-keystroke t))
+ (its-delete-backward-SYL n killflag)))
+
;; TODO: killflag
(defun its-delete-backward-within-SYL (syl n killflag)
(let* ((keyseq (its-get-keyseq-syl syl))
(len (length keyseq))
- (p (point))
- (its-current-map (get-text-property (1- (point)) 'its-map)))
+ (p (- (point) (length (its-get-output syl))))
+ (its-current-map (get-text-property (1- (point)) 'its-map))
+ back pp)
+ (if (< n 0)
+ (signal 'args-out-of-range (list (- (point) n) (point))))
+ (if its-delete-by-keystroke
+ (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
+ (setq pp p)
+ (while (and (setq syl (get-text-property (1- p) 'its-syl))
+ (its-DSYL-with-back-p syl)
+ (<= (setq back (- (its-get-kst/t syl))) len)
+ (> back (- len n))
+ (equal (substring (its-get-keyseq syl) (- back))
+ (substring keyseq 0 back)))
+ (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
+ len (length keyseq)
+ p (- p (length (its-get-output syl)))))
+ (if (and (eq p pp) syl (> n len))
+ (setq n (- n len)
+ keyseq (its-get-keyseq-syl syl)
+ len (length keyseq)
+ p (- p (length (its-get-output syl))))))
+ (if (and (> n len) (its-concrete-DSYL-p syl))
+ (setq len 1)))
+ (if (> n len)
+ (setq n (- n len)
+ len 0))
+ (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
+ (setq n (1- n)
+ p (- p (length (its-get-output syl)))))
(if (> n len)
- (signal 'args-out-of-range (list p n)))
- ;; Delete CURSOR
- (delete-region p (1+ p))
- (its-buffer-delete-SYL syl)
- (if (= n len)
- ;; Check if empty
- (let ((s (get-text-property (1- (point)) 'its-start))
- (e (get-text-property (point) 'its-end)))
- (if (and s e)
- (its-exit-mode-internal)
- (its-put-cursor (not its-delete-by-keystroke))))
- (setq keyseq (substring keyseq 0 (- len n)))
- (let ((r (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))
- (its-put-cursor r)))))
-
-;; XXX: NIY
+ (signal 'beginning-of-buffer nil))
+ (delete-region p (point))
+ (cond
+ ((> len n)
+ (its-state-machine-keyseq (substring keyseq 0 (- len n))
+ 'its-buffer-ins/del-SYL))
+ ;; Check if empty
+ ((and (get-text-property (1- (point)) 'its-start)
+ (get-text-property (1+ (point)) 'its-end))
+ ;; Delete CURSOR
+ (delete-region (point) (1+ (point)))
+ (its-exit-mode-internal))
+ ((and its-delete-by-keystroke
+ (null (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl))))
+ (its-set-cursor-status 'its-cursor))
+ (t
+ (its-set-cursor-status t)))))
+
(defun its-transpose-chars (n)
- (interactive)
+ (interactive "p")
(let ((syl (get-text-property (1- (point)) 'its-syl))
- (cursor (get-text-property (point) 'its-cursor)))
- (if (null syl)
- (signal 'beginning-of-buffer nil)
- (if (eq cursor t)
- (its-delete-backward-SYL-internal n nil)
- (its-delete-backward-within-SYL syl 2 nil)))))
+ (cursor (get-text-property (point) 'its-cursor))
+ keyseq len)
+ (cond
+ ((null syl)
+ (signal 'beginning-of-buffer nil))
+ ((eq cursor t)
+ (if (and (= n 1) (get-text-property (1+ (point)) 'its-end))
+ (progn
+ (its-backward-SYL 1)
+ (setq syl (get-text-property (1- (point)) 'its-syl))
+ (if (null syl)
+ (signal 'beginning-of-buffer nil))))
+ (its-buffer-delete-SYL syl)
+ (while (> n 0)
+ (if (get-text-property (1+ (point)) 'its-end)
+ (progn
+ (its-buffer-ins/del-SYL syl nil t)
+ (signal 'end-of-buffer nil)))
+ (its-forward-SYL 1)
+ (setq n (1- n)))
+ (while (< n 0)
+ (if (get-text-property (1- (point)) 'its-start)
+ (progn
+ (its-buffer-ins/del-SYL syl nil t)
+ (signal 'beginning-of-buffer nil)))
+ (its-backward-SYL 1)
+ (setq n (1+ n)))
+ (its-buffer-ins/del-SYL syl nil t))
+ (t
+ (setq keyseq (its-get-keyseq-syl syl)
+ len (length keyseq))
+ (cond
+ ((or (> n 1) (<= len 1))
+ (signal 'end-of-buffer nil))
+ ((>= (- n) len)
+ (signal 'beginning-of-buffer nil))
+ (t
+ (setq n (if (> n 0) (- -1 n) (1- n)))
+ (setq keyseq (concat (substring keyseq 0 n)
+ (substring keyseq -1)
+ (substring keyseq n -1)))
+ (if (and its-barf-on-invalid-keyseq
+ (null (its-keyseq-acceptable-p keyseq)))
+ (its-input-error))
+ (delete-region (- (point) (length (its-get-output syl))) (point))
+ (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))))))
;; Return VOID
(defun its-input-end ()
(its-exit-mode-internal t))
(defun its-in-fence-p ()
- (let ((prop (get-text-property (point) 'intangible)))
- (or (eq prop 'its-part-1) (eq prop 'its-part-2))))
+ (eq (get-text-property (point) 'intangible) 'its-part-2))
\f
(defvar its-translation-result "" "")
projects / elisp / egg.git / commitdiff