From: kate <kate>
Date: Tue, 3 Mar 1998 08:15:38 +0000 (+0000)
Subject: Backward deletion and transpose in fence mode is fixed.
X-Git-Tag: egg-980304~2^2~3
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=3b1b646570da95116a477ee3c97e756f4ebd2b38;p=elisp%2Fegg.git

Backward deletion and transpose in fence mode is fixed.
---

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 "" "")