;;; Code:
(require 'cl)
+(require 'egg-edep)
(defvar its-current-map nil)
(make-variable-buffer-local 'its-current-map)
;;
;;
-(eval-when (eval load compile)
- (require 'its-keydef))
+(require 'its-keydef)
(defvar its-mode-map
(let ((map (make-sparse-keymap))
(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.")
+(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)
(if face (cdr face) its-fence-face)))
(defun its-put-cursor (cursor)
- (let ((p (point))
- (map (copy-keymap its-mode-map)))
- (its-define-select-keys map)
+ (let ((p (point)))
(insert "!")
- (add-text-properties p (point) (list 'local-map map
+ (add-text-properties p (point) (list 'local-map 'its-mode-map
'read-only t
'invisible t
'intangible 'its-part-2
(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
+ ;; Put open-fence before inhibit-read-only to detect read-only
(insert its-fence-open)
(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
+ (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)
(its-input syl key)))
(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)))
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))))
+ (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))
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)
(let ((inhibit-read-only t))
(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)
+ (its-set-part-2 begpos (point))
(goto-char begpos)))
(its-put-cursor t)))
(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)
+ (its-set-part-1 (point) endpos)
(goto-char endpos)))
(its-put-cursor t)))
(let ((inhibit-read-only t))
(delete-region (if (get-text-property (1- (point)) 'its-start)
(point)
- (previous-single-property-change (1- (point)) 'its-start))
+ (previous-single-property-change (point) 'its-start))
(if (get-text-property (point) 'its-end)
(point)
(next-single-property-change (point) 'its-end)))
(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)
(setq syl (get-text-property p 'its-syl))
(setq n (1- n)))
;; Make SYLs have property of "part 1"
- (put-text-property old-point p 'intangible 'its-part-1)
+ (its-set-part-1 old-point p)
(goto-char p)
(its-put-cursor t)
(if (> n 0)
;; TODO: killflag
(defun its-delete-backward-within-SYL (syl n killflag)
- (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))
- (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)))))
+ (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 "p")
(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))
+ 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 (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)))
- (egg-set-face p (point) (its-get-fence-face)))))
+ (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
- (add-text-properties start end '(read-only t intangible its-part-1))
- (add-text-properties start end '(read-only t intangible its-part-2))
+ (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))))
(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 ()
(if proceed-to-conversion
(egg-convert-region start end)
;; Remove all properties
- (set-text-properties start end nil)
+ (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))))
(insert its-translation-result)))
\f
(defun its-set-mode-line-title ()
- (let ((title (its-get-indicator its-current-map)))
+ (let ((title (its-get-indicator (symbol-value its-current-map))))
(setq current-input-method-title (if its-previous-select-func
(concat "<" title ">")
title))
(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