(require 'cl)
+(defvar its-current-map nil)
+(make-variable-buffer-local 'its-current-map)
+(put 'its-current-map 'permanent-local t)
+
+(defvar its-current-select-func nil)
+(make-variable-buffer-local 'its-current-select-func)
+(put 'its-current-select-func 'permanent-local t)
+
+(defvar its-previous-select-func nil)
+(make-variable-buffer-local 'its-previous-select-func)
+(put 'its-previous-select-func 'permanent-local t)
+
(defvar its-current-language)
(make-variable-buffer-local 'its-current-language)
+(put 'its-current-language 'permanent-local t)
\f
;; Data structure in ITS
;; (1) SYL and CURSOR
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))
+
;;
;;
+(eval-when (eval load compile)
+ (require 'its-keydef))
+
(defvar its-mode-map
(let ((map (make-sparse-keymap))
(i 33))
(define-key map "\C-a" 'its-beginning-of-input-buffer)
(define-key map "\C-b" 'its-backward-SYL)
+ (define-key map "\C-c" 'its-cancel-input)
(define-key map "\C-d" 'its-delete-SYL)
(define-key map "\C-e" 'its-end-of-input-buffer)
(define-key map "\C-f" 'its-forward-SYL)
+ (define-key map "\C-g" 'its-select-previous-mode)
(define-key map "\C-]" 'its-cancel-input)
(define-key map "\C-h" 'its-mode-help-command)
(define-key map "\C-k" 'its-kill-line)
(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 "\C-w" 'its-kick-convert-region)
+ (define-key map "\C-y" 'its-yank)
+ (define-key map "\M-y" 'its-yank-pop)
+ (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)
(while (< i 127)
(define-key map (vector i) 'its-self-insert-char)
(setq i (1+ i)))
- (define-key map " " 'its-kick-convert-region)
+ (define-key map " " 'its-kick-convert-region-or-self-insert)
(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.")
-(defvar its-fence-open "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
-(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")
+(defvar its-fence-open "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\e(B)")
+(defvar its-fence-close "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z0J>e\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-get-fence-face ()
+ (let ((face (and (consp its-fence-face)
+ (or (assoc its-current-language its-fence-face)
+ (assoc t its-fence-face)))))
+ (if face (cdr face) its-fence-face)))
(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
+ 'read-only t
'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
;; 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 '(rear-nonsticky t its-end t intangible its-part-2))
+ (p (point)) p1)
+ ;; Put open-fence before inhibit-read-only to detect read-nly
(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)))
- (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)))
+ (let ((inhibit-read-only t))
+ (setq p1 (point))
+ (add-text-properties p p1 open-props)
+ (insert its-fence-close)
+ (add-text-properties p1 (point) close-props)
+ (if its-fence-face
+ (put-text-property p (point) 'invisible t))
+ (put-text-property p (point) 'read-only t)
+ (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)))
-(defun its-restart (str)
+(defun its-restart (str &optional set-prop)
(let (p)
- (its-insert-fence-open)
- (its-insert-fence-close)
+ (its-setup-fence-mode)
(setq p (point))
(insert str)
- (put-text-property p (point) 'intangible 'its-part-2)
- (goto-char p)
- (its-put-cursor t)))
+ (if set-prop
+ (its-setup-yanked-portion p (point)))
+ (its-beginning-of-input-buffer)))
(defun its-self-insert-char ()
(interactive)
- (let ((key last-command-char)
+ (let ((inhibit-read-only t)
+ (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)))
-
-(defvar its-current-map nil)
-(make-variable-buffer-local 'its-current-map)
-(put 'its-current-map 'permanent-local t)
+ (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)))
(defun its-initial-ISYL ()
(its-get-start-state its-current-map))
(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.")
\f
;;;
;;; ITS State Machine
;;;
+(defvar its-disable-special-action nil)
+
;; 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
+ ((and next-state
+ (not (and its-disable-special-action
+ (eq (its-get-kst/t next-state) t))))
+ (setq kst/t (its-get-kst/t next-state)
+ output (its-get-output next-state)
+ keyseq (its-get-keyseq next-state))
+ (cond
+ ;; Special actions.
+ ((eq kst/t t)
+ (funcall emit (cons "" keyseq) state 'its-cursor)
+ (apply (car output) (cdr output)))
+
+ ;; 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.")
(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)
- (its-buffer-delete-SYL oldsyl)
- (its-update-latest-SYL newsyl)
- (let ((p (point)))
- (insert (its-get-output newsyl))
- (add-text-properties p (point)
- (list 'its-syl newsyl
- 'its-map its-current-map
- 'its-lang its-current-language
- 'intangible 'its-part-1))
- (if its-fence-face
- (put-text-property p (point) 'face its-fence-face))))
+(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)))
+ (let ((inhibit-read-only t))
+ (its-buffer-delete-SYL oldsyl)
+ (its-update-latest-SYL newsyl)
+ (let ((p (point)))
+ (insert (its-get-output newsyl))
+ (add-text-properties p (point)
+ (list 'its-map its-current-map
+ 'its-syl newsyl
+ 'egg-lang its-current-language
+ 'read-only t
+ 'intangible 'its-part-1))
+ (if its-fence-face
+ (put-text-property p (point) 'face (its-get-fence-face)))
+ (its-set-cursor-status cursor))))
(defun its-buffer-delete-SYL (syl)
(let ((len (length (its-get-output syl))))
(defun its-get-next-state (state key)
(let ((kst/t (its-get-kst/t state)))
- (cdr (assq key (car kst/t)))))
+ (and (listp kst/t)
+ (cdr (assq key (car kst/t))))))
;; XXX XXX XXX
(defun its-otherwise-match (expr key)
(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))
+ (its-current-map its-current-map)
+ (its-current-select-func its-current-select-func)
+ (its-current-language its-current-language)
+ (its-zhuyin its-zhuyin)
+ (its-previous-select-func its-previous-select-func)
+ cursor)
+ (if (null syl)
+ (setq syl (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 (and syl eol)
+ (setq cursor (its-state-machine syl -1 emit)))
+ (not (eq cursor 'its-keyseq-test-failed))))
\f
;;;
;;; Name --> map
(defun its-make-next-state (state key keyseq output &optional back)
(let ((next-state (its-new-state output keyseq back))
(kst (its-get-kst/t state)))
- (if kst
- (setcar kst (cons (cons key next-state) (car kst)))
+ (cond
+ ((null kst)
(its-set-kst state (list (list (cons key next-state)))))
+ ((consp kst)
+ (setcar kst (cons (cons key next-state) (car kst))))
+ (t
+ (error "Can't make new state after %S" (its-get-keyseq state))))
next-state))
+
+(defmacro its-defrule-select-mode-temporally (input select-func)
+ `(its-defrule ,input '(its-select-mode-temporally
+ ,(intern (concat "its-select-"
+ (symbol-name select-func))))
+ t))
\f
;;;
(defun its-beginning-of-input-buffer ()
(interactive)
- (its-input-end)
- (if (not (get-text-property (1- (point)) 'its-start))
- (let ((begpos (previous-single-property-change (point) 'its-start)))
- ;; Make SYLs have property of "part 2"
- (put-text-property begpos (point) 'intangible 'its-part-2)
- (goto-char begpos)))
- (its-put-cursor t))
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (if (not (get-text-property (1- (point)) 'its-start))
+ (let ((begpos (previous-single-property-change (point) 'its-start)))
+ ;; Make SYLs have property of "part 2"
+ (put-text-property begpos (point) 'intangible 'its-part-2)
+ (goto-char begpos)))
+ (its-put-cursor t)))
(defun its-end-of-input-buffer ()
(interactive)
- (its-input-end)
- (if (not (get-text-property (point) 'its-end))
- (let ((endpos (next-single-property-change (point) 'its-end)))
- ;; Make SYLs have property of "part 1"
- (put-text-property (point) endpos 'intangible 'its-part-1)
- (goto-char endpos)))
- (its-put-cursor t))
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (if (not (get-text-property (point) 'its-end))
+ (let ((endpos (next-single-property-change (point) 'its-end)))
+ ;; Make SYLs have property of "part 1"
+ (put-text-property (point) endpos 'intangible 'its-part-1)
+ (goto-char endpos)))
+ (its-put-cursor t)))
+
+(defun its-kill-line (n)
+ (interactive "p")
+ (let ((inhibit-read-only t)
+ (p (point)))
+ (its-input-end)
+ (if (> n 0)
+ (cond
+ ((get-text-property (1- (point)) 'its-start)
+ (its-cancel-input))
+ ((get-text-property (point) 'its-end)
+ (its-put-cursor t))
+ (t
+ (delete-region (next-single-property-change (point) 'its-end)
+ (point))
+ (its-put-cursor t)))
+ (cond
+ ((get-text-property (point) 'its-end)
+ (its-cancel-input))
+ ((get-text-property (1- (point)) 'its-start)
+ (its-put-cursor t))
+ (t
+ (delete-region (point)
+ (previous-single-property-change (point) 'its-start))
+ (its-put-cursor t))))))
+
+(defun its-cancel-input ()
+ (interactive)
+ (let ((inhibit-read-only t))
+ (delete-region (if (get-text-property (1- (point)) 'its-start)
+ (point)
+ (previous-single-property-change (1- (point)) 'its-start))
+ (if (get-text-property (point) 'its-end)
+ (point)
+ (next-single-property-change (point) 'its-end)))
+ (its-put-cursor t)
+ (its-exit-mode-internal)))
;; TODO: move in VSYL
(defun its-backward-SYL (n)
(interactive "p")
- (its-input-end)
- (let ((syl (get-text-property (1- (point)) 'its-syl))
- (p (point))
- (old-point (point)))
+ (let ((inhibit-read-only t)
+ syl p old-point)
+ (its-input-end)
+ (setq syl (get-text-property (1- (point)) 'its-syl)
+ p (point)
+ old-point (point))
(while (and syl (> n 0))
(setq p (- p (length (its-get-output syl))))
(setq syl (get-text-property (1- p) 'its-syl))
;; TODO: move in VSYL
(defun its-forward-SYL (n)
(interactive "p")
- (its-input-end)
- (let ((syl (get-text-property (point) 'its-syl))
- (p (point))
- (old-point (point)))
+ (let ((inhibit-read-only t)
+ syl p old-point)
+ (its-input-end)
+ (setq syl (get-text-property (point) 'its-syl)
+ p (point)
+ old-point (point))
(while (and syl (> n 0))
(setq p (+ p (length (its-get-output syl))))
(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)
;; TODO: handle VSYL. KILLFLAG
(defun its-delete-SYL (n killflag)
(interactive "p\nP")
- (its-input-end)
- (let ((syl (get-text-property (point) 'its-syl))
- (p (point)))
+ (let ((inhibit-read-only t)
+ syl p)
+ (its-input-end)
+ (setq syl (get-text-property (point) 'its-syl)
+ p (point))
(while (and syl (> n 0))
(setq p (+ p (length (its-get-output syl))))
(setq syl (get-text-property p 'its-syl))
(if (> n 0)
(progn
(its-put-cursor t)
- (signal 'args-out-of-range (list p n)))
+ (signal 'end-of-buffer nil))
(delete-region (point) p)
+ (its-put-cursor t)
;; 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 t))))))
+ (if (and (get-text-property (1- (point)) 'its-start)
+ (get-text-property (1+ (point)) 'its-end))
+ (its-exit-mode-internal)))))
;; TODO: killflag
(defun its-delete-backward-SYL (n killflag)
(interactive "p\nP")
- (let ((syl (get-text-property (1- (point)) 'its-syl))
+ (let ((inhibit-read-only t)
+ (syl (get-text-property (1- (point)) 'its-syl))
(cursor (get-text-property (point) 'its-cursor)))
(if (null syl)
(signal 'beginning-of-buffer nil)
(setq syl (get-text-property (1- p) 'its-syl))
(setq n (1- n)))
(if (> n 0)
- (signal 'args-out-of-range (list p n))
+ (signal 'beginning-of-buffer nil)
(delete-region p (1+ (point))) ; also delete cursor
+ (its-put-cursor t)
;; 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 t))))))
+ (if (and (get-text-property (1- (point)) 'its-start)
+ (get-text-property (1+ (point)) 'its-end))
+ (its-exit-mode-internal)))))
(defvar its-delete-by-keystroke nil)
+(defun its-delete-backward-SYL-by-keystroke (n killflag)
+ (interactive "p\nP")
+ (let ((inhibit-read-only t)
+ (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))
+ (its-current-language (get-text-property (1- (point)) 'egg-lang))
+ 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)
- (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
+ (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 '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))
+ (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)
- (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)))))
+ (interactive "p")
+ (let ((inhibit-read-only t)
+ (syl (get-text-property (1- (point)) 'its-syl))
+ (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)))))))
+
+(defun its-yank (&optional arg)
+ (interactive "*P")
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (its-put-cursor t)
+ (yank arg)
+ (its-setup-yanked-portion (region-beginning) (region-end))))
+
+(defun its-yank-pop (arg)
+ (interactive "*p")
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (its-put-cursor t)
+ (yank-pop arg)
+ (its-setup-yanked-portion (region-beginning) (region-end))))
+
+(defun its-setup-yanked-portion (start end)
+ (let ((yank-before (eq (point) end))
+ (max-sisheng (make-char 'chinese-sisheng 127))
+ p syl lang)
+ (remove-text-properties start end '(intangible nil))
+ (egg-separate-languages start end t)
+ (goto-char start)
+ (while (< (point) end)
+ (setq p (point)
+ lang (get-text-property p 'egg-lang))
+ (if (and
+ (or (equal lang "Chinese-GB") (equal lang "Chinese-CNS"))
+ (<= (following-char) max-sisheng)
+ (setq len (egg-chinese-syllable (buffer-substring (point) end))))
+ (goto-char (+ (point) len))
+ (forward-char))
+ (setq syl (buffer-substring-no-properties p (point)))
+ (put-text-property p (point) 'its-syl (cons syl syl))
+ (if its-fence-face
+ (let ((its-current-language (get-text-property p 'egg-lang)))
+ (put-text-property p (point) 'face (its-get-fence-face)))))
+ (if yank-before
+ (add-text-properties start end '(read-only t intangible its-part-1))
+ (add-text-properties start end '(read-only t intangible its-part-2))
+ (delete-region (point) (1+ (point)))
+ (goto-char start)
+ (its-put-cursor t))))
;; Return VOID
(defun its-input-end ()
(defun its-exit-mode ()
"Exit ITS mode."
(interactive)
- (its-input-end)
- (its-exit-mode-internal))
-
-(defun its-exit-mode-off-input-method ()
- "Exit ITS mode."
- (interactive)
- (its-input-end)
- (its-exit-mode-internal)
- (inactivate-input-method))
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (its-put-cursor t)
+ (its-exit-mode-internal)))
;; TODO: handle overwrite-mode, insertion-hook, fill...
(defun its-exit-mode-internal (&optional proceed-to-conversion)
- (let (start end)
+ (let (start end s e)
+ (its-select-previous-mode t)
+ ;; Delete CURSOR
+ (delete-region (point) (1+ (point)))
;; Delete open fence
- (if (get-text-property (1- (point)) 'its-start)
- (setq start (1- (point)))
- (setq start (1- (previous-single-property-change (point) 'its-start))))
- (delete-region start (1+ start))
+ (setq s (if (get-text-property (1- (point)) 'its-start)
+ (point)
+ (previous-single-property-change (point) 'its-start))
+ start (- s (length its-fence-open)))
+ (delete-region start s)
;; Delete close fence
- (if (get-text-property (point) 'its-end)
- (setq end (point))
- (setq end (next-single-property-change (point) 'its-end)))
- (delete-region end (1+ end))
- ;; Remove all properties added by ITS
- (remove-text-properties start end '(its-map nil
- face nil
- intangible nil))
+ (setq end (if (get-text-property (point) 'its-end)
+ (point)
+ (next-single-property-change (point) 'its-end))
+ e (+ end (length its-fence-close)))
+ (delete-region end e)
(if proceed-to-conversion
(egg-convert-region start end)
- (remove-text-properties start end '(its-lang nil its-syl nil))
+ ;; Remove all properties
+ (set-text-properties start end nil)
(egg-do-auto-fill)
(run-hooks 'input-method-after-insert-chunk-hook))))
(defun its-kick-convert-region ()
(interactive)
- (its-input-end)
- (its-exit-mode-internal t))
+ (let ((inhibit-read-only t))
+ (its-input-end)
+ (its-put-cursor t)
+ (its-exit-mode-internal t)))
+
+(defun its-kick-convert-region-or-self-insert ()
+ (interactive)
+ (let ((syl (and (null (get-text-property (point) 'its-cursor))
+ (get-text-property (1- (point)) 'its-syl))))
+ (if (its-keyseq-acceptable-p (vector last-command-char) syl)
+ (its-self-insert-char)
+ (its-kick-convert-region))))
(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 nil "")
+(defvar its-translation-result "" "")
-(defun its-ins/del-SYL-batch (newsyl oldsyl)
- (let (output)
+(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))))
- (progn
- ;; DSYL
- (setq output (its-get-output newsyl))
- (put-text-property 0 (length output)
- 'its-lang its-current-language output)
- (setq its-translation-result
- (cons output its-translation-result))))))
+ ;; DSYL
+ (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)
+ 'egg-lang its-current-language
+ its-translation-result)))
+ cursor)
(defun its-translate-region (start end)
(interactive "r")
(its-translate-region-internal start end)
- (remove-text-properties start (point) '(its-lang nil)))
+ (set-text-properties start (point) nil))
(defun its-translate-region-internal (start end)
- (setq its-translation-result nil)
+ (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)))
(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)))
\f
-(require 'its-keydef)
+(defun its-set-mode-line-title ()
+ (let ((title (its-get-indicator its-current-map)))
+ (setq current-input-method-title (if its-previous-select-func
+ (concat "<" title ">")
+ title))
+ (force-mode-line-update)))
+
+(defun its-select-mode-temporally (func)
+ (let ((select-func its-current-select-func))
+ (funcall func)
+ (if (null its-previous-select-func)
+ (setq its-previous-select-func select-func))
+ (its-set-mode-line-title)))
+
+(defun its-select-previous-mode (&optional quiet)
+ (interactive)
+ (if (null its-previous-select-func)
+ (if (null quiet)
+ (beep))
+ (funcall its-previous-select-func)
+ (setq its-previous-select-func nil)
+ (its-set-mode-line-title)))
(provide 'its)
;;; its.el ends here.
projects / elisp / egg.git / blobdiff