;;; Code:
(require 'cl)
+(require 'egg-edep)
+
+(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))
+
;;
;;
+(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)
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")
+(fset 'its-mode-map its-mode-map)
+
+(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")
+(defvar its-fence-invisible 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)))
(insert "!")
- (add-text-properties p (point) (list 'local-map its-mode-map
+ (add-text-properties p (point) (list 'local-map 'its-mode-map
+ 'read-only t
'invisible t
'intangible 'its-part-2
'its-cursor cursor))
;;
(defun its-setup-fence-mode ()
(let ((open-props '(its-start t intangible its-part-1))
- (close-props '(its-end t intangible its-part-2))
+ (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-only
(insert its-fence-open)
- (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 'invisible t p (point)))
- (goto-char p1)
- (its-put-cursor t)))
+ (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-invisible
+ (put-text-property p (point) 'invisible t))
+ (put-text-property p (point) 'read-only t)
+ (goto-char p1)
+ (its-define-select-keys its-mode-map t)
+ (its-put-cursor t))))
(defun its-start (key)
(let ((its-setup-fence-before-insert-SYL t))
- (its-input nil key)
- (force-mode-line-update)))
+ (its-input nil key)))
-(defun its-restart (str)
+(defun its-restart (str &optional set-prop)
(let (p)
- (its-setup-fence-mode t)
+ (its-setup-fence-mode)
(setq p (point))
(insert str)
+ (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)
- (syl nil))
- (if (null (get-text-property (point) 'its-cursor))
- (setq syl (get-text-property (1- (point)) 'its-syl)))
+ (let ((inhibit-read-only t)
+ (key last-command-char)
+ (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)
-(make-variable-buffer-local 'its-current-map)
-(put 'its-current-map 'permanent-local t)
-
(defun its-initial-ISYL ()
- (its-get-start-state its-current-map))
+ (its-get-start-state (symbol-value 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.
(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
;;;
+(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 kst/t output keyseq back)
(cond
;; proceed to next status
- (next-state
+ ((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))
(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.
+ ;; Here we arrive to a terminal state.
+ ;; Emit a DSYL, and go ahead.
(t
(funcall emit next-state state 'its-cursor))))
((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)))
(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)))
- (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))
- (its-set-cursor-status cursor)))
+ (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
+ (egg-set-face p (point) (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)))
+ (if (numberp (cdr syl))
+ nil
+ (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
(defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
`(progn
(eval-when (eval compile)
- (let ((its-current-map (its-new-map ,name ,indicator ,lang)))
+ (let ((its-current-map 'its-temporaly-map)
+ (its-temporaly-map (its-new-map ,name ,indicator ,lang)))
,@exprs
- (setq ,map its-current-map)))
+ (setq ,map its-temporaly-map)))
(define-its-compiled-map ,map ,doc)))
(defmacro define-its-compiled-map (map doc)
(defmacro define-its-state-machine-append (map &rest exprs)
(append
- `(let ((its-current-map ,map)))
+ `(let ((its-current-map 'its-temporaly-map)
+ (its-temporaly-map ,map)))
exprs
- (list `(setq ,map its-current-map))))
+ (list `(setq ,map its-temporaly-map))))
;;
;; Construct State Machine
(defun its-goto-state (input &optional initial-state build-if-none)
(let ((len (length input))
(i 0)
- (state (or initial-state (its-get-start-state its-current-map))))
+ (state (or initial-state
+ (its-get-start-state (symbol-value its-current-map)))))
(while (< i len)
(setq state
(or (its-get-next-state state (aref input i))
(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-set-part-1 (beg end)
+ (let ((inhibit-point-motion-hooks t)
+ (str (buffer-substring beg end)))
+ (goto-char beg)
+ (delete-region beg end)
+ (put-text-property 0 (- end beg) 'intangible 'its-part-1 str)
+ (insert str)))
+
+(defun its-set-part-2 (beg end)
+ (let ((inhibit-point-motion-hooks t)
+ (str (buffer-substring beg end)))
+ (goto-char beg)
+ (delete-region beg end)
+ (put-text-property 0 (- end beg) 'intangible 'its-part-2 str)
+ (insert str)))
+
(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"
+ (its-set-part-2 begpos (point))
+ (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"
+ (its-set-part-1 (point) endpos)
+ (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 (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))
(setq n (1- n)))
;; Make SYLs have property of "part 2"
- (put-text-property p old-point 'intangible 'its-part-2)
+ (its-set-part-2 p old-point)
(goto-char p)
(its-put-cursor t)
(if (> n 0)
;; 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)
+ (its-set-part-1 old-point p)
(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)))
- (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
+ (if (let* ((keyseq (its-get-keyseq-syl syl))
+ (len (length keyseq))
+ (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)
+ (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))
+ (if (> len n)
+ (its-state-machine-keyseq (substring keyseq 0 (- len n))
+ 'its-buffer-ins/del-SYL)
+ (its-set-cursor-status
+ (if (or (null its-delete-by-keystroke)
+ (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl)))
+ t
+ 'its-cursor)))
+ (and (get-text-property (1- (point)) 'its-start)
+ (get-text-property (1+ (point)) 'its-end)))
+ (its-exit-mode-internal)))
+
(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))
+ syl lang source no-prop-source len i j l)
+ (setq source (buffer-substring start end)
+ no-prop-source (buffer-substring-no-properties start end)
+ len (length source))
+ (remove-text-properties 0 len '(intangible nil) source)
+ (egg-separate-languages source (get-text-property (1- start) 'egg-lang))
+ (setq i 0)
+ (while (< i len)
+ (setq lang (get-text-property i 'egg-lang source))
+ (if (and
+ (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
+ (setq l (egg-chinese-syllable source i)))
+ (setq j (+ i l))
+ (setq j (+ i (egg-char-bytes (egg-string-to-char-at source i)))))
+ (setq syl (substring no-prop-source i j))
+ (put-text-property i j 'its-syl (cons syl syl) source)
+ (setq i j))
+ (if its-fence-face
+ (let (its-current-language)
+ (setq i 0)
+ (while (< i len)
+ (setq j (egg-next-single-property-change i 'egg-lang source len)
+ its-current-language (get-text-property i 'egg-lang source))
+ (egg-set-face i j (its-get-fence-face) source)
+ (setq i j))))
+ (delete-region start end)
+ (if yank-before
+ (progn
+ (add-text-properties 0 len '(read-only t intangible its-part-1) source)
+ (insert source))
+ (delete-region (point) (1+ (point)))
+ (add-text-properties 0 len '(read-only t intangible its-part-2) source)
+ (insert source)
+ (goto-char start)
+ (its-put-cursor t))))
;; Return VOID
(defun its-input-end ()
(let ((cursor (get-text-property (point) 'its-cursor)))
;; key "END"
(if (null cursor)
- (its-input (get-text-property (1- (point)) 'its-syl) -1))
+ (let ((its-current-language (get-text-property (1- (point)) 'egg-lang)))
+ (its-input (get-text-property (1- (point)) 'its-syl) -1)))
(delete-region (point) (1+ (point)))))
(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
+ (goto-char start)
+ (setq s (buffer-substring-no-properties start end))
+ (delete-region start end)
+ (insert s)
(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 "" "")
(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
+ '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 "")
(delete-region start end)
(insert its-translation-result)))
\f
-(require 'its-keydef)
+(defun its-set-mode-line-title ()
+ (let ((title (its-get-indicator (symbol-value 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)))
+
+(defun its-mode ()
+ "\\{its-mode-map}"
+ ;; dummy function to get docstring
+ )
+
+(defun its-mode-help-command ()
+ "Display documentation for ITS mode."
+ (interactive)
+ (with-output-to-temp-buffer "*Help*"
+ (princ "ITS mode:\n")
+ (princ (documentation 'its-mode))
+ (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
(provide 'its)
;;; its.el ends here.
projects / elisp / egg.git / blobdiff