From 3b1b646570da95116a477ee3c97e756f4ebd2b38 Mon Sep 17 00:00:00 2001 From: kate Date: Tue, 3 Mar 1998 08:15:38 +0000 Subject: [PATCH] Backward deletion and transpose in fence mode is fixed. --- its.el | 242 +++++++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 188 insertions(+), 54 deletions(-) diff --git a/its.el b/its.el index a97c860..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,6 +158,19 @@ (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)) + ;; ;; @@ -176,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) @@ -257,9 +275,16 @@ (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) @@ -272,21 +297,33 @@ (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. @@ -297,13 +334,6 @@ (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")) - ;;; ;;; ITS State Machine @@ -339,22 +369,23 @@ ((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 @@ -372,14 +403,18 @@ (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))) @@ -426,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 @@ -575,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) @@ -634,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 () @@ -717,8 +852,7 @@ 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 "" "") -- 1.7.10.4