X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=its.el;h=0c78b7fb824d5d42b30683aafe6ecf917c52d0fb;hb=3b1b646570da95116a477ee3c97e756f4ebd2b38;hp=56bab987234155efd38cea11d429324b5f76d385;hpb=03c39fadd173acf1f5527acbf17d3938a7a40e94;p=elisp%2Fegg.git diff --git a/its.el b/its.el index 56bab98..0c78b7f 100644 --- a/its.el +++ b/its.el @@ -144,8 +144,10 @@ 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))) @@ -156,9 +158,24 @@ (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)) + ;; ;; +(require 'its-keydef) + (defvar its-mode-map (let ((map (make-sparse-keymap)) (i 33)) @@ -174,7 +191,10 @@ (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) @@ -184,18 +204,13 @@ (define-key map " " 'its-kick-convert-region) (define-key map "\177" 'its-delete-backward-SYL) ;; - (define-key map "\C-p" 'its-previous-map) - (define-key map "\C-n" 'its-next-map) -; (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer -; (define-key map "\M-k" 'its-katakana) -; (define-key map "\M-<" 'its-hankaku) -; (define-key map "\M->" 'its-zenkaku) -; (define-key map "\M-\C-h" 'its-select-hiragana) -; (define-key map "\M-\C-k" 'its-select-katakana) -;;; (define-key map "\M-q" 'its-select-downcase) ; -; (define-key map "\M-Q" 'its-select-upcase) -; (define-key map "\M-z" 'its-select-zenkaku-downcase) -; (define-key map "\M-Z" 'its-select-zenkaku-upcase) + (define-key map "\M-p" 'its-previous-map) + (define-key map "\M-n" 'its-next-map) + (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer + (define-key map "\M-k" 'its-katakana) + (define-key map "\M-<" 'its-hankaku) + (define-key map "\M->" 'its-zenkaku) + (its-define-select-keys map t) map) "Keymap for ITS mode.") @@ -203,14 +218,23 @@ (defvar its-fence-close "|" "*フェンスの終点を示す文字列 (1 文字)") (defvar its-fence-face nil "*フェンス表示に用いる face または nil") +(defconst its-setup-fence-before-insert-SYL nil) + (defun its-put-cursor (cursor) - (let ((p (point))) + (let ((p (point)) + (map (copy-keymap its-mode-map))) + (its-define-select-keys map) (insert "!") - (add-text-properties p (point) (list 'local-map its-mode-map + (add-text-properties p (point) (list 'local-map map 'invisible t '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 @@ -222,50 +246,46 @@ ;; 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) - (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))) + (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) (make-variable-buffer-local 'its-current-map) @@ -277,36 +297,43 @@ (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. - (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) (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.") ;;; ;;; ITS State Machine @@ -315,44 +342,51 @@ ;; 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 + (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)) + + (t + ;; XXX Should make DSYL (instead of VSYL)? + (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 "The latest SYL inserted.") @@ -363,28 +397,32 @@ (defun its-state-machine-keyseq (keyseq emit &optional eol) (let ((i 0) (len (length keyseq)) - (its-barf-on-invalid-keyseq nil) ; temporally disable DING (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)))) - (if eol + (cond + ((numberp (cdr syl)) + ;; VSYL - no need looping + (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)))) + (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))) -(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))) @@ -395,7 +433,8 @@ '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)))) @@ -422,6 +461,31 @@ (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)))) ;;; ;;; Name --> map @@ -571,7 +635,7 @@ Return last state." (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) @@ -630,38 +694,113 @@ Return last state." (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 () @@ -713,28 +852,36 @@ Return last state." (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)) -(defvar its-translation-result nil "") +(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)) (not (its-kst-p (its-get-kst/t newsyl)))) ;; DSYL - (setq its-translation-result - (cons (its-get-output newsyl) its-translation-result)))) - -(defun its-translate-region (start end &optional map) + (let ((output (its-get-output newsyl)) + (oldlen (length its-translation-result))) + (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))) + cursor) + +(defun its-translate-region (start end) (interactive "r") - (setq its-translation-result nil) + (its-translate-region-internal start end) + (remove-text-properties start (point) '(its-lang nil))) + +(defun its-translate-region-internal (start end) + (setq its-translation-result "") (goto-char start) (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))) @@ -746,9 +893,7 @@ Return last state." (if (eq syl its-latest-SYL) (its-state-machine syl -1 'its-ins/del-SYL-batch)) (delete-region start end) - (apply 'insert (reverse its-translation-result)))) + (insert its-translation-result))) -(require 'its-keydef) - (provide 'its) ;;; its.el ends here.