;;; Code:
-(require 'cl)
+(eval-when-compile
+ (require 'cl))
+
(require 'egg-edep)
(defgroup its nil
- "Input Translation System of Tamagotchy"
+ "Input Translation System of Tamago 4."
:group 'egg)
(defcustom its-enable-fullwidth-alphabet t
:group 'its :type 'boolean)
(defcustom its-delete-by-keystroke nil
- "*Delete characters as if cancel input keystroke, if nin-NIL."
+ "*Delete characters as if cancel input keystroke, if nin-NIL.
+This variable is overriden by `its-delete-by-character'."
+ :group 'its :type 'boolean)
+
+(defcustom its-delete-by-character nil
+ "*Delete a character as a unit even if just after input, if nin-NIL.
+This variable override `its-delete-by-keystroke'."
:group 'its :type 'boolean)
(defcustom its-fence-invisible nil
(make-variable-buffer-local 'its-previous-select-func)
(put 'its-previous-select-func 'permanent-local t)
-(defvar its-current-language)
+(defvar its-current-language nil)
(make-variable-buffer-local 'its-current-language)
(put 'its-current-language 'permanent-local t)
\f
(defsubst its-kst-p (kst/t)
(not (or (numberp kst/t) (null kst/t))))
-(defsubst its-get-output (syl/state)
- (car syl/state))
+(defun its-get-output (syl/state &optional no-eval)
+ (setq syl/state (car syl/state))
+ (cond ((null (consp syl/state))
+ syl/state)
+ ((and (null no-eval) (eq (car syl/state) 'eval))
+ (eval (mapcar (lambda (s) (if (stringp s) (copy-sequence s) s))
+ (cdr syl/state))))
+ (t
+ (copy-sequence syl/state))))
(defsubst its-set-output (state output)
(setcar state output))
(if (consp (cdr syl))
(cons (its-get-output syl) (its-get-keyseq-syl syl))
syl))
-
+
;;
;;
(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 [(meta backspace)] 'its-delete-backward-SYL-by-keystroke)
+ (define-key map [(meta delete)] 'its-delete-backward-SYL-by-keystroke)
(define-key map [right] 'its-forward-SYL)
(define-key map [left] 'its-backward-SYL)
(while (< i 127)
;;
(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)
+ (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer
+ (define-key map "\M-k" 'its-katakana)
+ (define-key map "\M-<" 'its-half-width)
+ (define-key map "\M->" 'its-full-width)
map)
"Keymap for ITS mode.")
-
(fset 'its-mode-map its-mode-map)
+(defvar its-fence-mode nil)
+(make-variable-buffer-local 'its-fence-mode)
+(put 'its-fence-mode 'permanent-local t)
+
+(defvar egg-sub-mode-map-alist nil)
+(or (assq 'its-fence-mode egg-sub-mode-map-alist)
+ (setq egg-sub-mode-map-alist (cons '(its-fence-mode . its-mode-map)
+ egg-sub-mode-map-alist)))
+
+(defun its-enter/leave-fence (&optional old new)
+ (setq its-fence-mode (its-in-fence-p)))
+
+(add-hook 'egg-enter/leave-fence-hook 'its-enter/leave-fence)
+
(defconst its-setup-fence-before-insert-SYL nil)
(defun its-get-fence-face (lang)
(assq t its-fence-face)))))
(defun its-put-cursor (cursor)
- (if (null (eq its-barf-on-invalid-keyseq 'its-keyseq-test))
- (let ((p (point)))
- (insert "!")
- (add-text-properties p (point) (list 'local-map 'its-mode-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)
+ (unless (eq its-barf-on-invalid-keyseq 'its-keyseq-test)
+ (let ((p (point))
+ (str (copy-sequence "!")))
+ (set-text-properties 0 1 (list 'read-only t
+ 'invisible 'egg
+ 'intangible 'its-part-2
+ 'its-cursor cursor
+ 'point-entered 'egg-enter/leave-fence
+ 'point-left 'egg-enter/leave-fence
+ 'modification-hooks '(egg-modify-fence))
+ str)
+ (insert str)
+ (goto-char p))))
+
+(defun its-set-cursor-status (cursor)
+ (delete-region (point) (1+ (point)))
+ (its-put-cursor cursor)
cursor)
(defvar its-context nil)
(error "invalid fence"))
;; Put open-fence before inhibit-read-only to detect read-only
(insert (if its-context its-fence-continue its-fence-open))
+ (egg-setup-invisibility-spec)
(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) 'invisible 'egg))
(put-text-property p (point) 'read-only t)
(goto-char p1)
(its-define-select-keys its-mode-map t)
(add-hook hook func t)
(funcall func)
(run-hooks hook)
- (setq hook nil))))
+ (set hook nil))))
;; Data structure for map compaction
;; <node> ::= (<count> <node#> <original node>) ; atom
;; | (<count> <node#> (<node> . <node>)) ; cons cell
;;
;; <count> ::= integer ; 0 or negative - usage count
-;; ; psotive - generated common sub-tree
+;; ; positive - generated common sub-tree
;;
;; <node#> ::= integer ; subject to compaction
;; | nil ; not subject to compaction
`(1- (setq its-compaction-list (cons ,node its-compaction-list)
its-compaction-counter-2 (1+ its-compaction-counter-2))))
+(defmacro its-concat (&rest args)
+ `(concat ,@(mapcar (lambda (arg)
+ (if (stringp arg)
+ arg
+ `(if (numberp ,arg) (number-to-string ,arg) ,arg)))
+ args)))
+
(defmacro its-compaction-hash (name node parent lr type)
(if (null type)
- `(let ((hash (intern (concat ,@name) its-compaction-hash-table)))
+ `(let ((hash (intern (its-concat ,@name) its-compaction-hash-table)))
(if (null (boundp hash))
(car (set hash (list* (its-compaction-new-node) ,parent ,lr)))
(setq hash (symbol-value hash))
(its-compaction-set-lr ,parent ,lr (cdr hash))
(car hash)))
`(let ((hash ,(if (eq type 'integer)
- `(intern (concat ,@name) its-compaction-hash-table)
+ `(intern (its-concat ,@name) its-compaction-hash-table)
`(aref its-compaction-integer-table (+ ,node 10)))))
(if (null ,(if (eq type 'integer) '(boundp hash) 'hash))
(setq hash (,@(if (eq type 'integer)
(its-compaction-set-lr ,parent ,lr (cdr hash))
(car hash))))
-(defun its-map-compaction-internal (map parent lr)
+(defun its-map-compaction-internal (map parent lr &optional force)
(cond
- ((consp map) (let ((candidate (or (null (stringp (car map))) (cdr map)))
- (l (its-map-compaction-internal (car map) map 'car))
- (r (its-map-compaction-internal (cdr map) map 'cdr)))
- (if (and candidate l r)
- (its-compaction-hash (l " " r) map parent lr nil))))
- ((stringp map) (its-compaction-hash ("STR" map) map parent lr nil))
- ((integerp map) (if (and (>= map -10) (< map 128))
- (its-compaction-hash nil map parent lr small-int)
- (its-compaction-hash ("INT" map) map parent lr integer)))
- ((null map) 0)))
+ ((consp map)
+ (let* ((candidate (or (null (stringp (car map))) (cdr map)))
+ (sexp (or force (eq (car map) 'eval)))
+ (l (its-map-compaction-internal (car map) map 'car sexp))
+ (r (its-map-compaction-internal (cdr map) map 'cdr sexp)))
+ (if (or sexp (and candidate l r))
+ (its-compaction-hash (l " " r) map parent lr nil))))
+ ((stringp map)
+ (its-compaction-hash ("STR" map) map parent lr nil))
+ ((integerp map)
+ (if (and (>= map -10) (< map 128))
+ (its-compaction-hash nil map parent lr small-int)
+ (its-compaction-hash ("INT" map) map parent lr integer)))
+ ((null map) 0)
+ ((symbolp map)
+ (its-compaction-hash ("SYM" (symbol-name map)) map parent lr nil))))
(defvar its-map-rebuild-subtrees)
(setq state next-state))
((null build-if-none)
(error "No such state (%s)" input))
- (t
+ (t
(if (not (or brand-new (= i 1) (its-get-kst/t state)))
(its-set-interim-terminal-state state))
(setq state (its-make-next-state state key
state))
(defun its-set-interim-terminal-state (state &optional output)
- (its-make-next-state state -1 (or output (its-get-output state)))
+ (its-make-next-state state -1 (or output (its-get-output state t)))
(its-defrule-otherwise state output))
(defun its-defoutput (input display)
(put-text-property 0 (- end beg) 'intangible 'its-part-2 str)
(insert str)))
+(defun its-search-beginning ()
+ (if (get-text-property (1- (point)) 'its-start)
+ (point)
+ (previous-single-property-change (point) 'its-start)))
+
+(defun its-search-end ()
+ (if (get-text-property (point) 'its-end)
+ (point)
+ (next-single-property-change (point) 'its-end)))
+
(defun its-beginning-of-input-buffer ()
(interactive)
(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)))
+ (let ((begpos (its-search-beginning)))
+ (its-set-part-2 begpos (point))
+ (goto-char begpos))
(its-put-cursor t)))
(defun its-end-of-input-buffer ()
(interactive)
(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)))
+ (let ((endpos (its-search-end)))
+ (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)))
+ (let ((inhibit-read-only t))
(its-input-end)
(if (> n 0)
- (cond
- ((get-text-property (1- (point)) 'its-start)
- (its-cancel-input))
- ((get-text-property (point) 'its-end)
+ (if (= (its-search-beginning) (point))
+ (its-cancel-input)
+ (delete-region (its-search-end) (point))
(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))))))
+ (if (= (its-search-end) (point))
+ (its-cancel-input)
+ (delete-region (its-search-beginning) (point))
+ (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)))
+ (delete-region (its-search-beginning) (its-search-end))
(its-put-cursor t)
(its-exit-mode-internal)))
(cursor (get-text-property (point) 'its-cursor)))
(if (null syl)
(signal 'beginning-of-buffer nil)
- (if (eq cursor t)
+ (if (or (eq cursor t) (and cursor its-delete-by-character))
(its-delete-backward-SYL-internal n killflag)
(its-delete-backward-within-SYL syl n killflag)))))
(signal 'beginning-of-buffer nil))
(delete-region p (point))
(if (> len n)
- (its-state-machine-keyseq (substring keyseq 0 (- 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)
(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))
+ (if (or (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
+ (setq l (egg-chinese-syllable source i)))
+ (and (setq l (get-text-property i 'composition source))
+ (setq l (if (consp (car l)) (caar l) (cadr l)))
+ (eq (next-single-property-change i 'composition
+ source (length source))
+ l)))
+ (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)
;; TODO: handle overwrite-mode, insertion-hook, fill...
(defun its-exit-mode-internal (&optional proceed-to-conversion n)
- (let (start end s context)
+ (let (start end s context str)
(its-select-previous-mode t)
;; Delete CURSOR
(delete-region (point) (1+ (point)))
;; Delete open fence
- (setq s (if (get-text-property (1- (point)) 'its-start)
- (point)
- (previous-single-property-change (point) 'its-start))
- start (previous-single-property-change s 'its-start nil (point-min))
- context (get-text-property start 'its-context))
+ (setq s (its-search-beginning)
+ start (previous-single-property-change s 'its-start nil (point-min))
+ context (get-text-property start 'its-context))
(delete-region start s)
;; Delete close fence
- (setq end (if (get-text-property (point) 'its-end)
- (point)
- (next-single-property-change (point) 'its-end)))
+ (setq end (its-search-end))
(delete-region end
(next-single-property-change end 'its-end nil (point-max)))
(if proceed-to-conversion
(egg-convert-region start end context n)
;; Remove all properties
(goto-char start)
- (insert (prog1
- (buffer-substring-no-properties start end)
- (delete-region start end)))
+ (setq str (buffer-substring start end))
+ (egg-remove-all-text-properties 0 (length str) str)
+ (delete-region start end)
+ (insert str)
(egg-do-auto-fill)
(run-hooks 'input-method-after-insert-chunk-hook))))
(its-kick-convert-region n))))
(defun its-in-fence-p ()
- (eq (get-text-property (point) 'intangible) 'its-part-2))
+ (and (eq (get-text-property (point) 'intangible) 'its-part-2)
+ (get-text-property (point) 'read-only)))
\f
(defvar its-translation-result "" "")
(defun its-translate-region (start end)
(interactive "r")
(its-translate-region-internal start end)
- (set-text-properties start (point) nil))
+ (egg-remove-all-text-properties start (point)))
(defun its-translate-region-internal (start end)
(setq its-translation-result "")
(append alist its-stroke-input-alist))))
;;; its-hiragana : hiragana-region for input-buffer
+(defun its-hiragana ()
+ (interactive)
+ (its-convert (lambda (str lang) (japanese-hiragana str))))
;;; its-katakana : katanaka-region for input-buffer
+(defun its-katakana ()
+ (interactive)
+ (its-convert (lambda (str lang) (japanese-katakana str))))
+
+(defconst its-full-half-table (make-vector 100 nil))
+(defconst its-half-full-table (make-vector 100 nil))
+
+(let ((table '((Japanese
+ (?\e$B!!\e(B . ?\ ) (?\e$B!$\e(B . ?,) (?\e$B!%\e(B . ?.) (?\e$B!"\e(B . ?,) (?\e$B!#\e(B . ?.)
+ (?\e$B!'\e(B . ?:) (?\e$B!(\e(B . ?\;) (?\e$B!)\e(B . ??) (?\e$B!*\e(B . ?!)
+ (?\e$B!-\e(B . ?') (?\e$B!.\e(B . ?`) (?\e$B!0\e(B . ?^) (?\e$B!2\e(B . ?_) (?\e$B!1\e(B . ?~)
+ (?\e$B!<\e(B . ?-) (?\e$B!=\e(B . ?-) (?\e$B!>\e(B . ?-)
+ (?\e$B!?\e(B . ?/) (?\e$B!@\e(B . ?\\) (?\e$B!A\e(B . ?~) (?\e$B!C\e(B . ?|)
+ (?\e$B!F\e(B . ?`) (?\e$B!G\e(B . ?') (?\e$B!H\e(B . ?\") (?\e$B!I\e(B . ?\")
+ (?\e$B!J\e(B . ?\() (?\e$B!K\e(B . ?\)) (?\e$B!N\e(B . ?[) (?\e$B!O\e(B . ?])
+ (?\e$B!P\e(B . ?{) (?\e$B!Q\e(B . ?}) (?\e$B!R\e(B . ?<) (?\e$B!S\e(B . ?>)
+ (?\e$B!\\e(B . ?+) (?\e$B!]\e(B . ?-) (?\e$B!a\e(B . ?=) (?\e$B!c\e(B . ?<) (?\e$B!d\e(B . ?>)
+ (?\e$B!l\e(B . ?') (?\e$B!m\e(B . ?\") (?\e$B!o\e(B . ?\\) (?\e$B!p\e(B . ?$) (?\e$B!s\e(B . ?%)
+ (?\e$B!t\e(B . ?#) (?\e$B!u\e(B . ?&) (?\e$B!v\e(B . ?*) (?\e$B!w\e(B . ?@)
+ (?\e$B#0\e(B . ?0) (?\e$B#1\e(B . ?1) (?\e$B#2\e(B . ?2) (?\e$B#3\e(B . ?3) (?\e$B#4\e(B . ?4)
+ (?\e$B#5\e(B . ?5) (?\e$B#6\e(B . ?6) (?\e$B#7\e(B . ?7) (?\e$B#8\e(B . ?8) (?\e$B#9\e(B . ?9)
+ (?\e$B#A\e(B . ?A) (?\e$B#B\e(B . ?B) (?\e$B#C\e(B . ?C) (?\e$B#D\e(B . ?D) (?\e$B#E\e(B . ?E)
+ (?\e$B#F\e(B . ?F) (?\e$B#G\e(B . ?G) (?\e$B#H\e(B . ?H) (?\e$B#I\e(B . ?I) (?\e$B#J\e(B . ?J)
+ (?\e$B#K\e(B . ?K) (?\e$B#L\e(B . ?L) (?\e$B#M\e(B . ?M) (?\e$B#N\e(B . ?N) (?\e$B#O\e(B . ?O)
+ (?\e$B#P\e(B . ?P) (?\e$B#Q\e(B . ?Q) (?\e$B#R\e(B . ?R) (?\e$B#S\e(B . ?S) (?\e$B#T\e(B . ?T)
+ (?\e$B#U\e(B . ?U) (?\e$B#V\e(B . ?V) (?\e$B#W\e(B . ?W) (?\e$B#X\e(B . ?X) (?\e$B#Y\e(B . ?Y)
+ (?\e$B#Z\e(B . ?Z)
+ (?\e$B#a\e(B . ?a) (?\e$B#b\e(B . ?b) (?\e$B#c\e(B . ?c) (?\e$B#d\e(B . ?d) (?\e$B#e\e(B . ?e)
+ (?\e$B#f\e(B . ?f) (?\e$B#g\e(B . ?g) (?\e$B#h\e(B . ?h) (?\e$B#i\e(B . ?i) (?\e$B#j\e(B . ?j)
+ (?\e$B#k\e(B . ?k) (?\e$B#l\e(B . ?l) (?\e$B#m\e(B . ?m) (?\e$B#n\e(B . ?n) (?\e$B#o\e(B . ?o)
+ (?\e$B#p\e(B . ?p) (?\e$B#q\e(B . ?q) (?\e$B#r\e(B . ?r) (?\e$B#s\e(B . ?s) (?\e$B#t\e(B . ?t)
+ (?\e$B#u\e(B . ?u) (?\e$B#v\e(B . ?v) (?\e$B#w\e(B . ?w) (?\e$B#x\e(B . ?x) (?\e$B#y\e(B . ?y)
+ (?\e$B#z\e(B . ?z))
+ (Chinese-GB
+ (?\e$A!!\e(B . ?\ ) (?\e$A#,\e(B . ?,) (?\e$A#.\e(B . ?.) (?\e$A!"\e(B . ?,) (?\e$A!#\e(B . ?.)
+ (?\e$A#:\e(B . ?:) (?\e$A#;\e(B . ?\;) (?\e$A#?\e(B . ??) (?\e$A#!\e(B . ?!)
+ (?\e$A#`\e(B . ?`) (?\e$A#^\e(B . ?^) (?\e$A#_\e(B . ?_) (?\e$A#~\e(B . ?~)
+ (?\e$A!*\e(B . ?-)
+ (?\e$A#/\e(B . ?/) (?\e$A#\\e(B . ?\\) (?\e$A!+\e(B . ?~) (?\e$A#|\e(B . ?|)
+ (?\e$A!.\e(B . ?`) (?\e$A!/\e(B . ?') (?\e$A!0\e(B . ?\") (?\e$A!1\e(B . ?\")
+ (?\e$A#(\e(B . ?\() (?\e$A#)\e(B . ?\)) (?\e$A#[\e(B . ?[) ( ?\e$A#]\e(B . ?])
+ (?\e$A#{\e(B . ?{) (?\e$A#}\e(B . ?})
+ (?\e$A#+\e(B . ?+) (?\e$A#-\e(B . ?-) (?\e$A#=\e(B . ?=) (?\e$A#<\e(B . ?<) (?\e$A#>\e(B . ?>)
+ (?\e$A#'\e(B . ?') (?\e$A#"\e(B . ?\") (?\e$A#$\e(B . ?$) (?\e$A#%\e(B . ?%)
+ (?\e$A##\e(B . ?#) (?\e$A#&\e(B . ?&) (?\e$A#*\e(B . ?*) (?\e$A#@\e(B . ?@)
+ (?\e$A#0\e(B . ?0) (?\e$A#1\e(B . ?1) (?\e$A#2\e(B . ?2) (?\e$A#3\e(B . ?3) (?\e$A#4\e(B . ?4)
+ (?\e$A#5\e(B . ?5) (?\e$A#6\e(B . ?6) (?\e$A#7\e(B . ?7) (?\e$A#8\e(B . ?8) (?\e$A#9\e(B . ?9)
+ (?\e$A#A\e(B . ?A) (?\e$A#B\e(B . ?B) (?\e$A#C\e(B . ?C) (?\e$A#D\e(B . ?D) (?\e$A#E\e(B . ?E)
+ (?\e$A#F\e(B . ?F) (?\e$A#G\e(B . ?G) (?\e$A#H\e(B . ?H) (?\e$A#I\e(B . ?I) (?\e$A#J\e(B . ?J)
+ (?\e$A#K\e(B . ?K) (?\e$A#L\e(B . ?L) (?\e$A#M\e(B . ?M) (?\e$A#N\e(B . ?N) (?\e$A#O\e(B . ?O)
+ (?\e$A#P\e(B . ?P) (?\e$A#Q\e(B . ?Q) (?\e$A#R\e(B . ?R) (?\e$A#S\e(B . ?S) (?\e$A#T\e(B . ?T)
+ (?\e$A#U\e(B . ?U) (?\e$A#V\e(B . ?V) (?\e$A#W\e(B . ?W) (?\e$A#X\e(B . ?X) (?\e$A#Y\e(B . ?Y)
+ (?\e$A#Z\e(B . ?Z)
+ (?\e$A#a\e(B . ?a) (?\e$A#b\e(B . ?b) (?\e$A#c\e(B . ?c) (?\e$A#d\e(B . ?d) (?\e$A#e\e(B . ?e)
+ (?\e$A#f\e(B . ?f) (?\e$A#g\e(B . ?g) (?\e$A#h\e(B . ?h) (?\e$A#i\e(B . ?i) (?\e$A#j\e(B . ?j)
+ (?\e$A#k\e(B . ?k) (?\e$A#l\e(B . ?l) (?\e$A#m\e(B . ?m) (?\e$A#n\e(B . ?n) (?\e$A#o\e(B . ?o)
+ (?\e$A#p\e(B . ?p) (?\e$A#q\e(B . ?q) (?\e$A#r\e(B . ?r) (?\e$A#s\e(B . ?s) (?\e$A#t\e(B . ?t)
+ (?\e$A#u\e(B . ?u) (?\e$A#v\e(B . ?v) (?\e$A#w\e(B . ?w) (?\e$A#x\e(B . ?x) (?\e$A#y\e(B . ?y)
+ (?\e$A#z\e(B . ?z))
+ (Chinese-CNS
+ (?\e$(G!!\e(B . ?\ ) (?\e$(G!"\e(B . ?,) (?\e$(G!%\e(B . ?.) (?\e$(G!#\e(B . ?,) (?\e$(G!$\e(B . ?.)
+ (?\e$(G!(\e(B . ?:) (?\e$(G!'\e(B . ?\;) (?\e$(G!)\e(B . ??) (?\e$(G!*\e(B . ?!)
+ (?\e$(G!k\e(B . ?') (?\e$(G!j\e(B . ?`) (?\e$(G!T\e(B . ?^) (?\e$(G"%\e(B . ?_) (?\e$(G"#\e(B . ?~)
+ (?\e$(G"@\e(B . ?-)
+ (?\e$(G"_\e(B . ?/) (?\e$(G"`\e(B . ?\\) (?\e$(G"a\e(B . ?/) (?\e$(G"b\e(B . ?\\)
+ (?\e$(G"D\e(B . ?~) (?\e$(G"^\e(B . ?|)
+ (?\e$(G!d\e(B . ?`) (?\e$(G!e\e(B . ?')
+ (?\e$(G!h\e(B . ?\") (?\e$(G!i\e(B . ?\") (?\e$(G!f\e(B . ?\") (?\e$(G!g\e(B . ?\")
+ (?\e$(G!>\e(B . ?\() (?\e$(G!?\e(B . ?\))
+ (?\e$(G!F\e(B . ?[) (?\e$(G!G\e(B . ?]) (?\e$(G!b\e(B . ?[) (?\e$(G!c\e(B . ?])
+ (?\e$(G!B\e(B . ?{) (?\e$(G!C\e(B . ?}) (?\e$(G!`\e(B . ?{) (?\e$(G!a\e(B . ?})
+ (?\e$(G!R\e(B . ?<) (?\e$(G!S\e(B . ?>)
+ (?\e$(G"0\e(B . ?+) (?\e$(G"1\e(B . ?-) (?\e$(G"8\e(B . ?=) (?\e$(G"6\e(B . ?<) (?\e$(G"7\e(B . ?>)
+ (?\e$(G"c\e(B . ?$) (?\e$(G"h\e(B . ?%)
+ (?\e$(G!l\e(B . ?#) (?\e$(G!m\e(B . ?&) (?\e$(G!n\e(B . ?*) (?\e$(G"i\e(B . ?@)
+ (?\e$(G$!\e(B . ?0) (?\e$(G$"\e(B . ?1) (?\e$(G$#\e(B . ?2) (?\e$(G$$\e(B . ?3) (?\e$(G$%\e(B . ?4)
+ (?\e$(G$&\e(B . ?5) (?\e$(G$'\e(B . ?6) (?\e$(G$(\e(B . ?7) (?\e$(G$)\e(B . ?8) (?\e$(G$*\e(B . ?9)
+ (?\e$(G$A\e(B . ?A) (?\e$(G$B\e(B . ?B) (?\e$(G$C\e(B . ?C) (?\e$(G$D\e(B . ?D) (?\e$(G$E\e(B . ?E)
+ (?\e$(G$F\e(B . ?F) (?\e$(G$G\e(B . ?G) (?\e$(G$H\e(B . ?H) (?\e$(G$I\e(B . ?I) (?\e$(G$J\e(B . ?J)
+ (?\e$(G$K\e(B . ?K) (?\e$(G$L\e(B . ?L) (?\e$(G$M\e(B . ?M) (?\e$(G$N\e(B . ?N) (?\e$(G$O\e(B . ?O)
+ (?\e$(G$P\e(B . ?P) (?\e$(G$Q\e(B . ?Q) (?\e$(G$R\e(B . ?R) (?\e$(G$S\e(B . ?S) (?\e$(G$T\e(B . ?T)
+ (?\e$(G$U\e(B . ?U) (?\e$(G$V\e(B . ?V) (?\e$(G$W\e(B . ?W) (?\e$(G$X\e(B . ?X) (?\e$(G$Y\e(B . ?Y)
+ (?\e$(G$Z\e(B . ?Z)
+ (?\e$(G$[\e(B . ?a) (?\e$(G$\\e(B . ?b) (?\e$(G$]\e(B . ?c) (?\e$(G$^\e(B . ?d) (?\e$(G$_\e(B . ?e)
+ (?\e$(G$`\e(B . ?f) (?\e$(G$a\e(B . ?g) (?\e$(G$b\e(B . ?h) (?\e$(G$c\e(B . ?i) (?\e$(G$d\e(B . ?j)
+ (?\e$(G$e\e(B . ?k) (?\e$(G$f\e(B . ?l) (?\e$(G$g\e(B . ?m) (?\e$(G$h\e(B . ?n) (?\e$(G$i\e(B . ?o)
+ (?\e$(G$j\e(B . ?p) (?\e$(G$k\e(B . ?q) (?\e$(G$l\e(B . ?r) (?\e$(G$m\e(B . ?s) (?\e$(G$n\e(B . ?t)
+ (?\e$(G$o\e(B . ?u) (?\e$(G$p\e(B . ?v) (?\e$(G$q\e(B . ?w) (?\e$(G$r\e(B . ?x) (?\e$(G$s\e(B . ?y)
+ (?\e$(G$t\e(B . ?z))
+ (Korean
+ (?\e$(C!!\e(B . ?\ ) (?\e$(C#,\e(B . ?,) (?\e$(C#.\e(B . ?.)
+ (?\e$(C#:\e(B . ?:) (?\e$(C#;\e(B . ?\;) (?\e$(C#?\e(B . ??) (?\e$(C#!\e(B . ?!)
+ (?\e$(C!/\e(B . ?') (?\e$(C!.\e(B . ?`) (?\e$(C#^\e(B . ?^) (?\e$(C#_\e(B . ?_) (?\e$(C#~\e(B . ?~)
+ (?\e$(C!*\e(B . ?-) (?\e$(C!)\e(B . ?-)
+ (?\e$(C#/\e(B . ?/) (?\e$(C!,\e(B . ?\\) (?\e$(C!-\e(B . ?~) (?\e$(C#|\e(B . ?|)
+ (?\e$(C!.\e(B . ?`) (?\e$(C!/\e(B . ?') (?\e$(C!0\e(B . ?\") (?\e$(C!1\e(B . ?\")
+ (?\e$(C#(\e(B . ?\() (?\e$(C#)\e(B . ?\)) (?\e$(C#[\e(B . ?[) (?\e$(C#]\e(B . ?])
+ (?\e$(C#{\e(B . ?{) (?\e$(C#}\e(B . ?}) (?\e$(C!4\e(B . ?<) (?\e$(C!5\e(B . ?>)
+ (?\e$(C#+\e(B . ?+) (?\e$(C#-\e(B . ?-) (?\e$(C#=\e(B . ?=) (?\e$(C#<\e(B . ?<) (?\e$(C#>\e(B . ?>)
+ (?\e$(C#'\e(B . ?') (?\e$(C#"\e(B . ?\") (?\e$(C#\\e(B . ?\\) (?\e$(C#$\e(B . ?$) (?\e$(C#%\e(B . ?%)
+ (?\e$(C##\e(B . ?#) (?\e$(C#&\e(B . ?&) (?\e$(C#*\e(B . ?*) (?\e$(C#@\e(B . ?@)
+ (?\e$(C#0\e(B . ?0) (?\e$(C#1\e(B . ?1) (?\e$(C#2\e(B . ?2) (?\e$(C#3\e(B . ?3) (?\e$(C#4\e(B . ?4)
+ (?\e$(C#5\e(B . ?5) (?\e$(C#6\e(B . ?6) (?\e$(C#7\e(B . ?7) (?\e$(C#8\e(B . ?8) (?\e$(C#9\e(B . ?9)
+ (?\e$(C#A\e(B . ?A) (?\e$(C#B\e(B . ?B) (?\e$(C#C\e(B . ?C) (?\e$(C#D\e(B . ?D) (?\e$(C#E\e(B . ?E)
+ (?\e$(C#F\e(B . ?F) (?\e$(C#G\e(B . ?G) (?\e$(C#H\e(B . ?H) (?\e$(C#I\e(B . ?I) (?\e$(C#J\e(B . ?J)
+ (?\e$(C#K\e(B . ?K) (?\e$(C#L\e(B . ?L) (?\e$(C#M\e(B . ?M) (?\e$(C#N\e(B . ?N) (?\e$(C#O\e(B . ?O)
+ (?\e$(C#P\e(B . ?P) (?\e$(C#Q\e(B . ?Q) (?\e$(C#R\e(B . ?R) (?\e$(C#S\e(B . ?S) (?\e$(C#T\e(B . ?T)
+ (?\e$(C#U\e(B . ?U) (?\e$(C#V\e(B . ?V) (?\e$(C#W\e(B . ?W) (?\e$(C#X\e(B . ?X) (?\e$(C#Y\e(B . ?Y)
+ (?\e$(C#Z\e(B . ?Z)
+ (?\e$(C#a\e(B . ?a) (?\e$(C#b\e(B . ?b) (?\e$(C#c\e(B . ?c) (?\e$(C#d\e(B . ?d) (?\e$(C#e\e(B . ?e)
+ (?\e$(C#f\e(B . ?f) (?\e$(C#g\e(B . ?g) (?\e$(C#h\e(B . ?h) (?\e$(C#i\e(B . ?i) (?\e$(C#j\e(B . ?j)
+ (?\e$(C#k\e(B . ?k) (?\e$(C#l\e(B . ?l) (?\e$(C#m\e(B . ?m) (?\e$(C#n\e(B . ?n) (?\e$(C#o\e(B . ?o)
+ (?\e$(C#p\e(B . ?p) (?\e$(C#q\e(B . ?q) (?\e$(C#r\e(B . ?r) (?\e$(C#s\e(B . ?s) (?\e$(C#t\e(B . ?t)
+ (?\e$(C#u\e(B . ?u) (?\e$(C#v\e(B . ?v) (?\e$(C#w\e(B . ?w) (?\e$(C#x\e(B . ?x) (?\e$(C#y\e(B . ?y)
+ (?\e$(C#z\e(B . ?z))))
+ (hash (make-vector 100 nil))
+ lang pair)
+ (while table
+ (setq lang (caar table)
+ pair (cdar table)
+ table (cdr table))
+ (while pair
+ (set (intern (char-to-string (caar pair)) its-full-half-table)
+ (cdar pair))
+ (set (intern (concat (symbol-name lang) (char-to-string (cdar pair)))
+ its-half-full-table)
+ (caar pair))
+ (setq pair (cdr pair)))
+ hash))
+
+;;; its-half-width : half-width-region for input-buffer
+(defun its-half-width ()
+ (interactive)
+ (its-convert
+ (lambda (str lang)
+ (concat (mapcar (lambda (c)
+ (or (symbol-value (intern-soft (char-to-string c)
+ its-full-half-table))
+ c))
+ (string-to-sequence str 'list))))))
+
+;;; its-full-width : full-width-region for input-buffer
+(defun its-full-width ()
+ (interactive)
+ (its-convert
+ (lambda (str lang)
+ (if (egg-chinese-syllable str 0)
+ (copy-sequence str)
+ (concat (mapcar (lambda (c)
+ (or (symbol-value
+ (intern-soft (concat (symbol-name lang)
+ (char-to-string c))
+ its-half-full-table))
+ c))
+ (string-to-sequence str 'list)))))))
+
+(defun its-convert (func)
+ (let ((inhibit-read-only t))
+ (unwind-protect
+ (progn
+ (its-input-end)
+ (let* ((start (its-search-beginning))
+ (end (its-search-end))
+ (old-str (buffer-substring start end))
+ (len (length old-str))
+ (p 0)
+ (new-str ""))
+ (put-text-property 0 len 'intangible 'its-part-1 old-str)
+ (while (< p len)
+ (let* ((prop (text-properties-at p old-str))
+ (cmp (memq 'composition prop))
+ (old (its-get-output (plist-get prop 'its-syl)))
+ (new (funcall func old (plist-get prop 'egg-lang)))
+ (new-len (length new))
+ syl)
+ (unless (equal new old)
+ (when cmp
+ (if (eq prop cmp)
+ (setq prop (cddr prop))
+ (setcdr (nthcdr (- (length prop) (length cmp) 1) prop)
+ (cddr cmp))))
+ (setq syl (copy-sequence new))
+ (plist-put prop 'its-syl (cons syl syl)))
+ (add-text-properties 0 new-len prop new)
+ (setq new-str (concat new-str new)
+ p (+ p (length old)))))
+ (delete-region start end)
+ (insert new-str)))
+ (its-put-cursor t))))
(defun its-mode ()
"\\{its-mode-map}"
(princ (documentation 'its-mode))
(help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
+;; The `point-left' hook function will never be called in Emacs 21.2.50
+;; when the command `next-line' is used in the last line of a buffer
+;; which isn't terminated with a newline or the command `previous-line'
+;; is used in the first line of a buffer.
+(defun its-next-line (&optional arg)
+ "Go to the end of the line if the line isn't terminated with a newline,
+otherwise run `next-line' as usual."
+ (interactive "p")
+ (if (= (line-end-position) (point-max))
+ (end-of-line)
+ (next-line arg)))
+
+(defun its-previous-line (&optional arg)
+ "Go to the beginning of the line if it is called in the first line of a
+buffer, otherwise run `previous-line' as usual."
+ (interactive "p")
+ (if (= (line-beginning-position) (point-mim))
+ (beginning-of-line)
+ (previous-line arg)))
+
+(substitute-key-definition 'next-line 'its-next-line
+ its-mode-map global-map)
+(substitute-key-definition 'previous-line 'its-previous-line
+ its-mode-map global-map)
+
(provide 'its)
-;;; its.el ends here.
+
+;;; its.el ends here
projects / elisp / tamago.git / blobdiff