1 ;;; its.el --- Input Translation Systam AKA "ITS(uDekirunDa!)"
3 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
8 ;; KATAYAMA Yoshio <kate@pfu.co.jp>
9 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
10 ;; Keywords: mule, multilingual, input method
12 ;; This file will be part of GNU Emacs (in future).
14 ;; EGG is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; EGG is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
36 (defvar its-current-map nil)
37 (make-variable-buffer-local 'its-current-map)
38 (put 'its-current-map 'permanent-local t)
40 (defvar its-current-select-func nil)
41 (make-variable-buffer-local 'its-current-select-func)
42 (put 'its-current-select-func 'permanent-local t)
44 (defvar its-previous-select-func nil)
45 (make-variable-buffer-local 'its-previous-select-func)
46 (put 'its-previous-select-func 'permanent-local t)
48 (defvar its-current-language)
49 (make-variable-buffer-local 'its-current-language)
50 (put 'its-current-language 'permanent-local t)
52 ;; Data structure in ITS
55 ;; "SYL" stands for something like a syllable.
57 ;; <SYL> ::= ( <output> . ( <keyseq> . <terminal> )) ; Determined: DSYL
58 ;; | <state> ; Intermediate: ISYL
59 ;; | ( <output> . <point> ) ; Verbatim: VSYL
63 ;; ; ( <output> . ( <keyseq> . <key-state-table/terminal> ))
65 ;; <keyseq> ::= "string" of key sequence
66 ;; <output> ::= "string"
68 ;; <point> ::= integer which specifies point
70 ;; <cursor> ::= nil ; Previous SYL is active (input will go that SYL)
71 ;; | t ; input makes new SYL. DEL deletes previous SYL
72 ;; | its-cursor ; DEL breaks previous SYL, input makes new SYL
74 ;; Data structures in ITS
75 ;; (2) State machine which recognizes SYL
77 ;; <state> ::= ( <output> <keyseq> . <key-state-table/terminal> )
79 ;; <key-state-table/terminal> ::= <key-state-table> ; intermediate state
80 ;; | <terminal> ; terminal state
82 ;; <key-state-table> ::= ( <key-state-alist> . <expr-output-back-list> )
83 ;; <key-state-alist> ::= ( <key-state> ... )
84 ;; <key-state> ::= ( <key> . <state> )
85 ;; <key> ::= Positive INTEGER which specifies KEY STROKE
86 ;; | -1 ; means END of key stroke
88 ;; Only applicable for last transition.
89 ;; <expr-output-back-list> ::= ( (<output> . (<keyexpr> . <howmanyback>))... )
90 ;; <keyexpr> ::= something like "[a-z]" which specifies class of key.
91 ;; | NIL; means ANY of key (except END of the key stroke)
94 ;; <keyseq> ::= "string"
99 ;; <howmanyback> ::= integer which specifies how many key strokes we go back
101 ;; <output> ::= "string"
103 ;; Data structure in ITS (3) Map
105 ;; <map> ::= ( <name> <indicator> <language> . <start-state> )
106 ;; <name> ::= "string"
107 ;; <indicator> ::= "string"
108 ;; <language> ::= "string"
109 ;; <start-state> ::= <state>
112 (defsubst its-new-state (output keyseq back)
113 (cons output (cons keyseq back)))
115 (defsubst its-new-map (name indicator language)
116 (cons name (cons indicator (cons language (its-new-state "" "" nil)))))
118 (defsubst its-get-indicator (map)
121 (defsubst its-get-language (map)
124 (defsubst its-get-start-state (map)
127 (defsubst its-get-kst/t (state)
130 (defsubst its-set-kst (state kst)
131 (setcdr (cdr state) kst))
133 (defsubst its-get-keyseq (state)
136 (defsubst its-set-keyseq (state keyseq)
137 (setcar (cdr state) keyseq))
139 (defun its-get-keyseq-cooked (state)
140 (let ((keyseq (its-get-keyseq state))
141 (back (its-get-kst/t state)))
143 (substring keyseq 0 back)
146 (defsubst its-kst-p (kst/t)
147 (not (or (numberp kst/t) (null kst/t))))
149 (defsubst its-get-output (syl/state)
152 (defsubst its-set-output (state output)
153 (setcar state output))
155 (defsubst its-get-keyseq-syl (syl)
157 (cond ((stringp l) ; DSYL
162 (substring (car l) 0 (cdr l)))
166 (defsubst its-eob-keyexpr (eob)
168 (defsubst its-eob-back (eob)
171 (defsubst its-make-class+back (class back)
173 (defsubst its-make-otherwise (output class+back)
174 (cons output class+back))
176 (defsubst its-DSYL-with-back-p (syl)
177 (and (consp (cdr syl))
178 (numberp (its-get-kst/t syl))))
180 (defsubst its-concrete-DSYL-p (syl)
183 (defsubst its-make-concrete-DSYL (syl)
184 (if (consp (cdr syl))
185 (cons (its-get-output syl) (its-get-keyseq-syl syl))
191 (require 'its-keydef)
194 (let ((map (make-sparse-keymap))
196 (define-key map "\C-a" 'its-beginning-of-input-buffer)
197 (define-key map "\C-b" 'its-backward-SYL)
198 (define-key map "\C-c" 'its-cancel-input)
199 (define-key map "\C-d" 'its-delete-SYL)
200 (define-key map "\C-e" 'its-end-of-input-buffer)
201 (define-key map "\C-f" 'its-forward-SYL)
202 (define-key map "\C-g" 'its-select-previous-mode)
203 (define-key map "\C-]" 'its-cancel-input)
204 (define-key map "\C-h" 'its-mode-help-command)
205 (define-key map "\C-k" 'its-kill-line)
206 ;; (define-key map "\C-l" 'its-exit-mode)
207 (define-key map "\C-m" 'its-exit-mode) ; RET
208 (define-key map [return] 'its-exit-mode)
209 (define-key map "\C-t" 'its-transpose-chars)
210 (define-key map "\C-w" 'its-kick-convert-region)
211 (define-key map "\C-y" 'its-yank)
212 (define-key map "\M-y" 'its-yank-pop)
213 (define-key map [backspace] 'its-delete-backward-SYL)
214 (define-key map [delete] 'its-delete-backward-SYL)
215 (define-key map [M-backspace] 'its-delete-backward-SYL-by-keystroke)
216 (define-key map [M-delete] 'its-delete-backward-SYL-by-keystroke)
217 (define-key map [right] 'its-forward-SYL)
218 (define-key map [left] 'its-backward-SYL)
220 (define-key map (vector i) 'its-self-insert-char)
222 (define-key map " " 'its-kick-convert-region-or-self-insert)
223 (define-key map "\177" 'its-delete-backward-SYL)
225 (define-key map "\M-p" 'its-previous-map)
226 (define-key map "\M-n" 'its-next-map)
227 (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer
228 (define-key map "\M-k" 'its-katakana)
229 (define-key map "\M-<" 'its-hankaku)
230 (define-key map "\M->" 'its-zenkaku)
232 "Keymap for ITS mode.")
234 (fset 'its-mode-map its-mode-map)
236 (defvar its-fence-open "|" "*
\e$B%U%'%s%9$N;OE@$r<($9J8;zNs
\e(B (1
\e$BJ8;z0J>e
\e(B)")
237 (defvar its-fence-close "|" "*
\e$B%U%'%s%9$N=*E@$r<($9J8;zNs
\e(B (1
\e$BJ8;z0J>e
\e(B)")
238 (defvar its-fence-face nil "*
\e$B%U%'%s%9I=<($KMQ$$$k
\e(B face
\e$B$^$?$O
\e(B nil")
239 (defvar its-fence-invisible nil)
241 (defconst its-setup-fence-before-insert-SYL nil)
243 (defun its-get-fence-face ()
244 (let ((face (and (consp its-fence-face)
245 (or (assoc its-current-language its-fence-face)
246 (assoc t its-fence-face)))))
247 (if face (cdr face) its-fence-face)))
249 (defun its-put-cursor (cursor)
252 (add-text-properties p (point) (list 'local-map 'its-mode-map
255 'intangible 'its-part-2
259 (defsubst its-set-cursor-status (cursor)
260 (put-text-property (point) (1+ (point)) 'its-cursor cursor)
264 ;; +-- START property
265 ;; | --- CURSOR Property
267 ;; v v v-- END Property
269 ;; ^^^ ^^^ ^^^------ SYL Property
271 ;; intangible intangible
274 (defun its-setup-fence-mode ()
275 (let ((open-props '(its-start t intangible its-part-1))
276 (close-props '(rear-nonsticky t its-end t intangible its-part-2))
278 ;; Put open-fence before inhibit-read-only to detect read-only
279 (insert its-fence-open)
280 (let ((inhibit-read-only t))
282 (add-text-properties p p1 open-props)
283 (insert its-fence-close)
284 (add-text-properties p1 (point) close-props)
285 (if its-fence-invisible
286 (put-text-property p (point) 'invisible t))
287 (put-text-property p (point) 'read-only t)
289 (its-define-select-keys its-mode-map t)
290 (its-put-cursor t))))
292 (defun its-start (key)
293 (let ((its-setup-fence-before-insert-SYL t))
294 (its-input nil key)))
296 (defun its-restart (str &optional set-prop)
298 (its-setup-fence-mode)
302 (its-setup-yanked-portion p (point)))
303 (its-beginning-of-input-buffer)))
305 (defun its-self-insert-char ()
307 (let ((inhibit-read-only t)
308 (key last-command-char)
309 (cursor (get-text-property (point) 'its-cursor))
310 (syl (get-text-property (1- (point)) 'its-syl)))
313 (not (eq (get-text-property (1- (point)) 'its-map) its-current-map)))
314 (put-text-property (- (point) (length (its-get-output syl))) (point)
315 'its-syl (its-make-concrete-DSYL syl))
319 (its-input syl key)))
321 (defun its-initial-ISYL ()
322 (its-get-start-state (symbol-value its-current-map)))
324 (defun its-make-VSYL (keyseq)
325 (cons keyseq (length keyseq)))
327 (defvar its-barf-on-invalid-keyseq nil
328 "T means don't allow invalid key sequence in input buffer.")
330 (defun its-input-error ()
331 (error "Invalid Romaji Sequence"))
334 (defun its-input (syl key)
336 (setq syl (its-initial-ISYL)))
337 (let ((output (car syl))
341 ;; k/kk/s is "point in keyseq"
342 (its-input-to-vsyl syl key k/kk/s output))
343 ((and its-barf-on-invalid-keyseq
344 (null (its-keyseq-acceptable-p (vector key) syl)))
345 ;; signal before altering
349 (its-state-machine syl key 'its-buffer-ins/del-SYL)))))
351 (defun its-input-to-vsyl (syl key point output)
353 (its-set-cursor-status t)
354 (let ((len (length output)))
356 ;; point is at end of VSYL. Don't need to call state machine.
357 (its-buffer-ins/del-SYL
358 (its-make-VSYL (concat output (vector key))) syl nil)
359 ;; point is at middle of VSYL.
360 (let ((new-keyseq (concat (substring output 0 point)
362 (substring output point))))
363 (its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
366 ;;; ITS State Machine
369 (defvar its-disable-special-action nil)
372 (defun its-state-machine (state key emit)
373 (let ((next-state (its-get-next-state state key))
374 expr-output-back kst/t output keyseq back)
376 ;; proceed to next status
378 (not (and its-disable-special-action
379 (eq (its-get-kst/t next-state) t))))
380 (setq kst/t (its-get-kst/t next-state)
381 output (its-get-output next-state)
382 keyseq (its-get-keyseq next-state))
386 (funcall emit (cons "" keyseq) state 'its-cursor)
387 (apply (car output) (cdr output)))
389 ;; Still, it's a intermediate state.
391 (funcall emit next-state state nil))
393 ;; It's negative integer which specifies how many
394 ;; characters we go backwards
396 (funcall emit next-state state 'its-cursor)
397 (its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
399 ;; Here we arrive to a terminal state.
400 ;; Emit a DSYL, and go ahead.
402 (funcall emit next-state state 'its-cursor))))
404 ;; push back by otherwise status
406 (setq expr-output-back (its-get-otherwise state key)))
407 (setq keyseq (concat (its-get-keyseq state) (vector key)))
409 (cons (its-get-output expr-output-back)
410 (cons keyseq (its-eob-back expr-output-back)))
412 (its-state-machine-keyseq
413 (substring keyseq (its-eob-back expr-output-back)) emit))
415 ((eq its-barf-on-invalid-keyseq 'its-keyseq-test)
416 'its-keyseq-test-failed)
418 ;; No next state for KEY. It's invalid sequence.
419 (its-barf-on-invalid-keyseq
423 ;; XXX Should make DSYL (instead of VSYL)?
424 (setq keyseq (concat (its-get-keyseq state) (if (> key 0) (vector key))))
425 (funcall emit (its-make-VSYL keyseq) state nil)))))
427 (defvar its-latest-SYL nil
428 "The latest SYL inserted.")
429 (defsubst its-update-latest-SYL (syl)
430 (setq its-latest-SYL syl))
433 (defun its-state-machine-keyseq (keyseq emit &optional eol)
435 (len (length keyseq))
436 (syl (its-initial-ISYL))
441 ;; VSYL - no need looping
443 (its-make-VSYL (concat (car syl) (substring keyseq i)))
448 (setq cursor (its-state-machine syl (aref keyseq i) emit))))
449 (if (eq cursor 'its-keyseq-test-failed)
451 (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
453 (if (and eol (not (eq cursor 'its-keyseq-test-failed)))
454 (its-state-machine syl -1 emit)
457 (defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
458 (if its-setup-fence-before-insert-SYL
460 (setq its-setup-fence-before-insert-SYL nil)
461 (its-setup-fence-mode)))
462 (let ((inhibit-read-only t))
463 (its-buffer-delete-SYL oldsyl)
464 (its-update-latest-SYL newsyl)
466 (insert (its-get-output newsyl))
467 (add-text-properties p (point)
468 (list 'its-map its-current-map
470 'egg-lang its-current-language
472 'intangible 'its-part-1))
474 (egg-set-face p (point) (its-get-fence-face)))
475 (its-set-cursor-status cursor))))
477 (defun its-buffer-delete-SYL (syl)
478 (let ((len (length (its-get-output syl))))
479 (delete-region (- (point) len) (point))))
481 (defun its-get-next-state (state key)
482 (let ((kst/t (its-get-kst/t state)))
484 (cdr (assq key (car kst/t))))))
487 (defun its-otherwise-match (expr key)
488 (or (null expr) ; <expr>::= NIL means "ANY"
489 (let ((case-fold-search nil))
490 (string-match expr (char-to-string key)))))
492 (defun its-get-otherwise (state key)
493 (let* ((kst/t (its-get-kst/t state))
497 (setq expr-output-back (car ebl))
498 (let ((expr (its-eob-keyexpr expr-output-back)))
499 (if (its-otherwise-match expr key)
501 (setq ebl (cdr ebl)))))
504 (defun its-keyseq-acceptable-p (keyseq &optional syl eol)
506 (len (length keyseq))
507 (its-barf-on-invalid-keyseq 'its-keyseq-test)
509 (emit (lambda (nsyl osyl cursor)
510 (its-update-latest-SYL nsyl)
512 (its-current-map its-current-map)
513 (its-current-select-func its-current-select-func)
514 (its-current-language its-current-language)
515 (its-zhuyin its-zhuyin)
516 (its-previous-select-func its-previous-select-func)
519 (setq syl (its-initial-ISYL)))
520 (if (numberp (cdr syl))
522 (while (and syl (< i len))
523 (setq cursor (its-state-machine syl (aref keyseq i) emit))
525 ((eq cursor 'its-keyseq-test-failed)
528 (setq syl (its-initial-ISYL)))
533 (setq cursor (its-state-machine syl -1 emit)))
534 (not (eq cursor 'its-keyseq-test-failed)))))
541 (defvar its-map-alist nil)
543 (defun its-get-map (name)
544 (assoc name its-map-alist))
546 (defun its-register-map (map)
547 (let* ((name (car map))
548 (place (assoc name its-map-alist)))
550 (setcdr place (cdr map))
551 (setq its-map-alist (cons map its-map-alist)))
554 (defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
555 (let ((its-current-map map))
556 (set map (its-new-map name indicator
557 (if (eq (car-safe lang) 'quote) (nth 1 lang) lang)))
558 (eval (cons 'progn exprs)))
559 `(defconst ,map ',(symbol-value map) ,doc))
561 (defmacro define-its-state-machine-append (map &rest exprs)
562 `(let ((its-current-map ',map))
566 ;; Construct State Machine
568 (defun its-defrule (input output &optional back enable-overwrite)
569 "
\e$BF~NO
\e(B INPUT
\e$B$rG'<1$7
\e(B, OUTPUT
\e$B$r=PNO$9$k$h$&$K%9%F!<%H%^%7%s$r9=@.$9$k!#
\e(B
570 BACK
\e$B$,
\e(B(
\e$BIi$N
\e(B)
\e$B@0?t$N;~$O
\e(B, OUTPUT
\e$B$r=PNO$7$?8e
\e(B, BACK
\e$B$NJ,
\e(B key stroke
\e$B$r
\e(B
571 \e$BLa$C$FF0$/$b$N$H$9$k!#JQ495,B'$O$b$C$H$b:G6a$K
\e(B its-define-state-machine
572 \e$B$5$l$?JQ49I=$KEPO?$5$l$k!#
\e(B
574 (let ((state (its-goto-state input (if enable-overwrite t 'dup-check))))
575 (its-set-output state output)
576 (its-set-kst state back)
579 (defun its-defrule* (input output &optional enable-overwrite)
580 (let* ((state (its-goto-state input (if enable-overwrite t 'dup-check))))
581 (its-set-kst state nil)
582 (its-set-interim-terminal-state state output)
585 (defvar its-parent-states)
587 (defun its-goto-state (input &optional build-if-none)
588 (let ((len (length input))
590 (state (its-get-start-state (symbol-value its-current-map)))
591 brand-new next-state key)
592 (setq its-parent-states nil)
594 (setq its-parent-states (cons state its-parent-states)
597 next-state (its-get-next-state state key))
600 (setq state next-state))
601 ((null build-if-none)
602 (error "No such state (%s)" input))
604 (if (not (or brand-new (= i 1) (its-get-kst/t state)))
605 (its-set-interim-terminal-state state))
606 (setq state (its-make-next-state state key
607 (concat (its-get-output state)
610 (if (and (eq build-if-none 'dup-check) (null brand-new))
611 (error "Duplicated definition (%s)" input))
614 (defun its-set-interim-terminal-state (state &optional output)
615 (or output (setq output (its-get-output state)))
616 (its-make-next-state state -1 output)
617 (its-defrule-otherwise state output))
619 (defun its-defoutput (input display)
620 (let ((state (its-goto-state input)))
621 (its-set-output state display)))
623 (defun its-define-otherwise (state otherwise)
624 (let ((kst (its-get-kst/t state)))
626 (setcdr kst (cons otherwise (cdr kst)))
627 (its-set-kst state (cons nil (cons otherwise nil))))))
629 (defconst its-otherwise-back-one
630 (its-make-class+back nil -1))
632 (defun its-defrule-otherwise (state output &optional class back)
635 (setq class+back its-otherwise-back-one)
636 (setq class+back (its-make-class+back class back)))
637 (its-define-otherwise state
638 (its-make-otherwise output class+back))))
640 (defun its-make-next-state (state key output &optional back)
641 (let ((next-state (its-new-state output
642 (concat (its-get-keyseq state)
643 (if (> key 0) (list key)))
645 (kst (its-get-kst/t state)))
648 (its-set-kst state (list (list (cons key next-state)))))
650 (setcar kst (cons (cons key next-state) (car kst))))
652 (error "Can't make new state after %S" (its-get-keyseq state))))
655 (defmacro its-defrule-select-mode-temporally (input select-func)
656 `(its-defrule ,input '(its-select-mode-temporally
657 ,(intern (concat "its-select-"
658 (symbol-name select-func))))
662 (defun its-set-part-1 (beg end)
663 (let ((inhibit-point-motion-hooks t)
664 (str (buffer-substring beg end)))
666 (delete-region beg end)
667 (put-text-property 0 (- end beg) 'intangible 'its-part-1 str)
670 (defun its-set-part-2 (beg end)
671 (let ((inhibit-point-motion-hooks t)
672 (str (buffer-substring beg end)))
674 (delete-region beg end)
675 (put-text-property 0 (- end beg) 'intangible 'its-part-2 str)
678 (defun its-beginning-of-input-buffer ()
680 (let ((inhibit-read-only t))
682 (if (not (get-text-property (1- (point)) 'its-start))
683 (let ((begpos (previous-single-property-change (point) 'its-start)))
684 ;; Make SYLs have property of "part 2"
685 (its-set-part-2 begpos (point))
689 (defun its-end-of-input-buffer ()
691 (let ((inhibit-read-only t))
693 (if (not (get-text-property (point) 'its-end))
694 (let ((endpos (next-single-property-change (point) 'its-end)))
695 ;; Make SYLs have property of "part 1"
696 (its-set-part-1 (point) endpos)
700 (defun its-kill-line (n)
702 (let ((inhibit-read-only t)
707 ((get-text-property (1- (point)) 'its-start)
709 ((get-text-property (point) 'its-end)
712 (delete-region (next-single-property-change (point) 'its-end)
716 ((get-text-property (point) 'its-end)
718 ((get-text-property (1- (point)) 'its-start)
721 (delete-region (point)
722 (previous-single-property-change (point) 'its-start))
723 (its-put-cursor t))))))
725 (defun its-cancel-input ()
727 (let ((inhibit-read-only t))
728 (delete-region (if (get-text-property (1- (point)) 'its-start)
730 (previous-single-property-change (point) 'its-start))
731 (if (get-text-property (point) 'its-end)
733 (next-single-property-change (point) 'its-end)))
735 (its-exit-mode-internal)))
737 ;; TODO: move in VSYL
738 (defun its-backward-SYL (n)
740 (let ((inhibit-read-only t)
743 (setq syl (get-text-property (1- (point)) 'its-syl)
746 (while (and syl (> n 0))
747 (setq p (- p (length (its-get-output syl))))
748 (setq syl (get-text-property (1- p) 'its-syl))
750 ;; Make SYLs have property of "part 2"
751 (its-set-part-2 p old-point)
755 (signal 'beginning-of-buffer nil))))
757 ;; TODO: move in VSYL
758 (defun its-forward-SYL (n)
760 (let ((inhibit-read-only t)
763 (setq syl (get-text-property (point) 'its-syl)
766 (while (and syl (> n 0))
767 (setq p (+ p (length (its-get-output syl))))
768 (setq syl (get-text-property p 'its-syl))
770 ;; Make SYLs have property of "part 1"
771 (its-set-part-1 old-point p)
775 (signal 'end-of-buffer nil))))
777 ;; TODO: handle VSYL. KILLFLAG
778 (defun its-delete-SYL (n killflag)
780 (let ((inhibit-read-only t)
783 (setq syl (get-text-property (point) 'its-syl)
785 (while (and syl (> n 0))
786 (setq p (+ p (length (its-get-output syl))))
787 (setq syl (get-text-property p 'its-syl))
792 (signal 'end-of-buffer nil))
793 (delete-region (point) p)
796 (if (and (get-text-property (1- (point)) 'its-start)
797 (get-text-property (1+ (point)) 'its-end))
798 (its-exit-mode-internal)))))
801 (defun its-delete-backward-SYL (n killflag)
803 (let ((inhibit-read-only t)
804 (syl (get-text-property (1- (point)) 'its-syl))
805 (cursor (get-text-property (point) 'its-cursor)))
807 (signal 'beginning-of-buffer nil)
809 (its-delete-backward-SYL-internal n killflag)
810 (its-delete-backward-within-SYL syl n killflag)))))
813 (defun its-delete-backward-SYL-internal (n killflag)
814 (let ((syl (get-text-property (1- (point)) 'its-syl))
816 (while (and syl (> n 0))
817 (setq p (- p (length (its-get-output syl))))
818 (setq syl (get-text-property (1- p) 'its-syl))
821 (signal 'beginning-of-buffer nil)
822 (delete-region p (1+ (point))) ; also delete cursor
825 (if (and (get-text-property (1- (point)) 'its-start)
826 (get-text-property (1+ (point)) 'its-end))
827 (its-exit-mode-internal)))))
829 (defvar its-delete-by-keystroke nil)
831 (defun its-delete-backward-SYL-by-keystroke (n killflag)
833 (let ((inhibit-read-only t)
834 (its-delete-by-keystroke t))
835 (its-delete-backward-SYL n killflag)))
838 (defun its-delete-backward-within-SYL (syl n killflag)
839 (if (let* ((keyseq (its-get-keyseq-syl syl))
840 (len (length keyseq))
841 (p (- (point) (length (its-get-output syl))))
842 (its-current-map (get-text-property (1- (point)) 'its-map))
843 (its-current-language (get-text-property (1- (point)) 'egg-lang))
846 (signal 'args-out-of-range (list (- (point) n) (point))))
847 (if its-delete-by-keystroke
848 (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
850 (while (and (setq syl (get-text-property (1- p) 'its-syl))
851 (its-DSYL-with-back-p syl)
852 (<= (setq back (- (its-get-kst/t syl))) len)
854 (equal (substring (its-get-keyseq syl) (- back))
855 (substring keyseq 0 back)))
856 (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
858 p (- p (length (its-get-output syl)))))
859 (if (and (eq p pp) syl (> n len))
861 keyseq (its-get-keyseq-syl syl)
863 p (- p (length (its-get-output syl))))))
864 (if (and (> n len) (its-concrete-DSYL-p syl))
869 (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
871 p (- p (length (its-get-output syl)))))
873 (signal 'beginning-of-buffer nil))
874 (delete-region p (point))
876 (its-state-machine-keyseq (substring keyseq 0 (- len n))
877 'its-buffer-ins/del-SYL)
878 (its-set-cursor-status
879 (if (or (null its-delete-by-keystroke)
880 (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl)))
883 (and (get-text-property (1- (point)) 'its-start)
884 (get-text-property (1+ (point)) 'its-end)))
885 (its-exit-mode-internal)))
887 (defun its-transpose-chars (n)
889 (let ((inhibit-read-only t)
890 (syl (get-text-property (1- (point)) 'its-syl))
891 (cursor (get-text-property (point) 'its-cursor))
895 (signal 'beginning-of-buffer nil))
897 (if (and (= n 1) (get-text-property (1+ (point)) 'its-end))
900 (setq syl (get-text-property (1- (point)) 'its-syl))
902 (signal 'beginning-of-buffer nil))))
903 (its-buffer-delete-SYL syl)
905 (if (get-text-property (1+ (point)) 'its-end)
907 (its-buffer-ins/del-SYL syl nil t)
908 (signal 'end-of-buffer nil)))
912 (if (get-text-property (1- (point)) 'its-start)
914 (its-buffer-ins/del-SYL syl nil t)
915 (signal 'beginning-of-buffer nil)))
918 (its-buffer-ins/del-SYL syl nil t))
920 (setq keyseq (its-get-keyseq-syl syl)
923 ((or (> n 1) (<= len 1))
924 (signal 'end-of-buffer nil))
926 (signal 'beginning-of-buffer nil))
928 (setq n (if (> n 0) (- -1 n) (1- n)))
929 (setq keyseq (concat (substring keyseq 0 n)
930 (substring keyseq -1)
931 (substring keyseq n -1)))
932 (if (and its-barf-on-invalid-keyseq
933 (null (its-keyseq-acceptable-p keyseq)))
935 (delete-region (- (point) (length (its-get-output syl))) (point))
936 (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))))))
938 (defun its-yank (&optional arg)
940 (let ((inhibit-read-only t))
944 (its-setup-yanked-portion (region-beginning) (region-end))))
946 (defun its-yank-pop (arg)
948 (let ((inhibit-read-only t))
952 (its-setup-yanked-portion (region-beginning) (region-end))))
954 (defun its-setup-yanked-portion (start end)
955 (let ((yank-before (eq (point) end))
956 syl lang source no-prop-source len i j l)
957 (setq source (buffer-substring start end)
958 no-prop-source (buffer-substring-no-properties start end)
960 (remove-text-properties 0 len '(intangible nil) source)
961 (egg-separate-languages source (get-text-property (1- start) 'egg-lang))
964 (setq lang (get-text-property i 'egg-lang source))
966 (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
967 (setq l (egg-chinese-syllable source i)))
969 (setq j (+ i (egg-char-bytes (egg-string-to-char-at source i)))))
970 (setq syl (substring no-prop-source i j))
971 (put-text-property i j 'its-syl (cons syl syl) source)
974 (let (its-current-language)
977 (setq j (egg-next-single-property-change i 'egg-lang source len)
978 its-current-language (get-text-property i 'egg-lang source))
979 (egg-set-face i j (its-get-fence-face) source)
981 (delete-region start end)
984 (add-text-properties 0 len '(read-only t intangible its-part-1) source)
986 (delete-region (point) (1+ (point)))
987 (add-text-properties 0 len '(read-only t intangible its-part-2) source)
990 (its-put-cursor t))))
993 (defun its-input-end ()
994 (let ((cursor (get-text-property (point) 'its-cursor)))
997 (let ((its-current-language (get-text-property (1- (point)) 'egg-lang)))
998 (its-input (get-text-property (1- (point)) 'its-syl) -1)))
999 (delete-region (point) (1+ (point)))))
1001 (defun its-exit-mode ()
1004 (let ((inhibit-read-only t))
1007 (its-exit-mode-internal)))
1009 ;; TODO: handle overwrite-mode, insertion-hook, fill...
1010 (defun its-exit-mode-internal (&optional proceed-to-conversion)
1011 (let (start end s e)
1012 (its-select-previous-mode t)
1014 (delete-region (point) (1+ (point)))
1015 ;; Delete open fence
1016 (setq s (if (get-text-property (1- (point)) 'its-start)
1018 (previous-single-property-change (point) 'its-start))
1019 start (- s (length its-fence-open)))
1020 (delete-region start s)
1021 ;; Delete close fence
1022 (setq end (if (get-text-property (point) 'its-end)
1024 (next-single-property-change (point) 'its-end))
1025 e (+ end (length its-fence-close)))
1026 (delete-region end e)
1027 (if proceed-to-conversion
1028 (egg-convert-region start end)
1029 ;; Remove all properties
1031 (setq s (buffer-substring-no-properties start end))
1032 (delete-region start end)
1035 (run-hooks 'input-method-after-insert-chunk-hook))))
1037 (defun its-kick-convert-region ()
1039 (let ((inhibit-read-only t))
1042 (its-exit-mode-internal t)))
1044 (defun its-kick-convert-region-or-self-insert ()
1046 (let ((syl (and (null (get-text-property (point) 'its-cursor))
1047 (get-text-property (1- (point)) 'its-syl))))
1048 (if (its-keyseq-acceptable-p (vector last-command-char) syl)
1049 (its-self-insert-char)
1050 (its-kick-convert-region))))
1052 (defun its-in-fence-p ()
1053 (eq (get-text-property (point) 'intangible) 'its-part-2))
1055 (defvar its-translation-result "" "")
1057 (defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
1058 (its-update-latest-SYL newsyl)
1060 (consp (cdr newsyl))
1061 (not (its-kst-p (its-get-kst/t newsyl))))
1063 (let ((output (its-get-output newsyl))
1064 (oldlen (length its-translation-result)))
1065 (setq its-translation-result (concat its-translation-result output))
1066 (put-text-property oldlen (length its-translation-result)
1067 'egg-lang its-current-language
1068 its-translation-result)))
1071 (defun its-translate-region (start end)
1073 (its-translate-region-internal start end)
1074 (set-text-properties start (point) nil))
1076 (defun its-translate-region-internal (start end)
1077 (setq its-translation-result "")
1080 (syl (its-initial-ISYL))
1081 ;; temporally enable DING
1082 (its-barf-on-invalid-keyseq t)
1084 (while (< (point) end)
1085 (let ((key (following-char)))
1086 (setq cursor (its-state-machine syl key 'its-ins/del-SYL-batch))
1089 (setq syl (its-initial-ISYL))
1090 (setq syl its-latest-SYL))))
1091 (if (eq syl its-latest-SYL)
1092 (its-state-machine syl -1 'its-ins/del-SYL-batch))
1093 (delete-region start end)
1094 (insert its-translation-result)))
1096 (defun its-set-mode-line-title ()
1097 (let ((title (its-get-indicator (symbol-value its-current-map))))
1098 (setq current-input-method-title (if its-previous-select-func
1099 (concat "<" title ">")
1101 (force-mode-line-update)))
1103 (defun its-select-mode-temporally (func)
1104 (let ((select-func its-current-select-func))
1106 (if (null its-previous-select-func)
1107 (setq its-previous-select-func select-func))
1108 (its-set-mode-line-title)))
1110 (defun its-select-previous-mode (&optional quiet)
1112 (if (null its-previous-select-func)
1115 (funcall its-previous-select-func)
1116 (setq its-previous-select-func nil)
1117 (its-set-mode-line-title)))
1121 ;; dummy function to get docstring
1124 (defun its-mode-help-command ()
1125 "Display documentation for ITS mode."
1127 (with-output-to-temp-buffer "*Help*"
1128 (princ "ITS mode:\n")
1129 (princ (documentation 'its-mode))
1130 (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
1133 ;;; its.el ends here.