1 ;;; egg-cnv.el --- Conversion Backend in Egg Input Method Architecture
3 ;; Copyright (C) 1997, 1998 Mule Project,
4 ;; Powered by Electrotechnical Laboratory, JAPAN.
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.
34 (defvar egg-current-language)
35 (make-variable-buffer-local 'egg-current-language)
36 (put 'egg-current-language 'permanent-local t)
38 (defsubst egg-bunsetsu-info () 'intangible)
40 (defun egg-get-bunsetsu-info (p)
41 (let ((bunsetsu-info (get-text-property p (egg-bunsetsu-info))))
43 (setq egg-conversion-backend (get-text-property p 'egg-backend)
44 egg-current-language (get-text-property p 'egg-lang)))
48 (defconst egg-conversion-backend-other-languages
49 [ egg-init-other-languages
51 egg-start-conversion-other-languages
52 egg-get-bunsetsu-converted-other-languages
53 egg-get-bunsetsu-source-other-languages
54 egg-list-candidates-other-languages
55 egg-get-number-of-candidates-other-languages
56 egg-get-current-candidate-number-other-languages
57 egg-get-all-candidates-other-languages
58 egg-decide-candidate-other-languages
59 egg-change-bunsetsu-length-other-languages
60 egg-end-conversion-other-languages
63 egg-fini-other-languages
66 (defun egg-init-other-languages ()
69 (defun egg-start-conversion-other-languages (yomi-string language)
71 (defun egg-get-bunsetsu-converted-other-languages (bunsetsu-info)
73 (defun egg-get-bunsetsu-source-other-languages (bunsetsu-info)
75 (defun egg-list-candidates-other-languages (bunsetsu-info prev-bunsetsu-info)
77 (defun egg-get-number-of-candidates-other-languages (bunsetsu-info)
79 (defun egg-get-current-candidate-number-other-languages (bunsetsu-info)
81 (defun egg-get-all-candidates-other-languages (bunsetsu-info)
83 (defun egg-decide-candidate-other-languages (bunsetsu-info candidate-pos)
85 (defun egg-change-bunsetsu-length-other-languages (b0 b1 b2 len)
86 (let ((s (concat b1 b2)))
87 (set-text-properties 0 (length s) nil s)
88 (if (= len (length s))
90 (list (substring s 0 len) (substring s len)))))
91 (defun egg-end-conversion-other-languages (bunsetsu-info-list)
93 (defun egg-fini-other-languages (language)
96 (defvar egg-conversion-backend-alist nil)
97 (make-variable-buffer-local 'egg-conversion-backend-alist)
98 (defvar egg-conversion-backend nil)
99 (make-variable-buffer-local 'egg-conversion-backend)
101 (defvar egg-finalize-backend-alist nil)
103 (defun egg-set-current-backend (language)
104 (setq egg-conversion-backend
105 (cdr (assoc language egg-conversion-backend-alist)))
106 (if (null egg-conversion-backend)
107 (setq egg-conversion-backend egg-conversion-backend-other-languages)))
109 (defun egg-initialize-backend (language)
110 (egg-set-current-backend language)
111 (funcall (aref egg-conversion-backend 0)))
113 (defun egg-start-conversion (yomi-string language)
114 (egg-set-current-backend language)
115 (funcall (aref egg-conversion-backend 1) yomi-string language))
116 (defun egg-get-bunsetsu-converted (bunsetsu-info)
117 (funcall (aref egg-conversion-backend 2) bunsetsu-info))
118 (defun egg-get-bunsetsu-source (bunsetsu-info)
119 (funcall (aref egg-conversion-backend 3) bunsetsu-info))
120 (defun egg-list-candidates (bunsetsu-info prev-bunsetsu-info)
121 (funcall (aref egg-conversion-backend 4) bunsetsu-info prev-bunsetsu-info))
122 (defun egg-get-number-of-candidates (bunsetsu-info)
123 (funcall (aref egg-conversion-backend 5) bunsetsu-info))
124 (defun egg-get-current-candidate-number (bunsetsu-info)
125 (funcall (aref egg-conversion-backend 6) bunsetsu-info))
126 (defun egg-get-all-candidates (bunsetsu-info)
127 (funcall (aref egg-conversion-backend 7) bunsetsu-info))
128 (defun egg-decide-candidate (bunsetsu-info candidate-pos)
129 (funcall (aref egg-conversion-backend 8) bunsetsu-info candidate-pos))
130 (defun egg-change-bunsetsu-length (b0 b1 b2 len)
131 (funcall (aref egg-conversion-backend 9) b0 b1 b2 len))
132 (defun egg-end-conversion (bunsetsu-info-list)
133 (funcall (aref egg-conversion-backend 10) bunsetsu-info-list))
134 (defun egg-start-reverse-conversion (yomi-string language)
135 (egg-set-current-backend language)
136 (if (aref egg-conversion-backend 11)
137 (funcall (aref egg-conversion-backend 11) yomi-string language)
140 (defun egg-finalize-backend ()
141 (let ((alist egg-finalize-backend-alist))
143 (funcall (car (car (car alist))) (cdr (car (car alist))))
144 (setq alist (cdr alist)))))
146 (defun egg-set-conversion-backend (backend langs &optional force)
149 (setq egg-conversion-backend backend)
150 (setq backend egg-conversion-backend))
152 (setq pair (assoc (car langs) egg-conversion-backend-alist))
155 (setq egg-conversion-backend-alist
156 (cons (cons (car langs) backend) egg-conversion-backend-alist)))
158 (setcdr pair backend)))
159 (setq pair (cons (aref backend (1- (length backend))) (car langs)))
160 (if (null (assoc pair egg-finalize-backend-alist))
161 (setq egg-finalize-backend-alist
162 (cons (list pair) egg-finalize-backend-alist)))
163 (setq langs (cdr langs)))))
165 (defvar egg-conversion-open "|" "*
\e$B%U%'%s%9$N;OE@$r<($9J8;zNs
\e(B (1
\e$BJ8;z0J>e
\e(B)")
166 (defvar egg-conversion-close "|" "*
\e$B%U%'%s%9$N=*E@$r<($9J8;zNs
\e(B (1
\e$BJ8;z0J>e
\e(B)")
167 (defvar egg-conversion-face nil "*
\e$B%U%'%s%9I=<($KMQ$$$k
\e(B face
\e$B$^$?$O
\e(B nil")
168 (defvar egg-conversion-separator " ")
170 (defun egg-get-conversion-face ()
171 (let ((face (and (listp egg-conversion-face)
172 (or (assoc egg-current-language egg-conversion-face)
173 (assoc t egg-conversion-face)))))
174 (if face (cdr face) egg-conversion-face)))
177 (defun egg-convert-region (start end)
182 (remove-text-properties start end '(read-only nil intangible nil))
184 (insert egg-conversion-open)
185 (let ((inhibit-read-only t)
187 bunsetsu-info-list contin p s e result)
188 (setq p (+ (point) (- end start)))
189 (set-text-properties start (point)
193 'egg-source (buffer-substring (point) p)))
194 (if egg-conversion-face
195 (put-text-property start (point) 'invisible t))
198 (insert egg-conversion-close)
199 (set-text-properties p (point) '(read-only t rear-nonsticky t egg-end t))
200 (if egg-conversion-face
201 (put-text-property p (point) 'invisible t))
203 (egg-separate-languages start max)
205 (while (< (point) max)
206 (setq egg-current-language (get-text-property (point) 'egg-lang)
209 (while (and (< e max)
210 (equal egg-current-language
211 (get-text-property e 'egg-lang)))
212 (setq e (next-single-property-change e 'egg-lang nil max)))
213 (condition-case result
214 (setq bunsetsu-info-list
215 (egg-start-conversion
216 (buffer-substring-no-properties s e)
217 egg-current-language))
219 (setq egg-conversion-backend egg-conversion-backend-other-languages
220 bunsetsu-info-list (egg-start-conversion-other-languages
221 (buffer-substring-no-properties s e)
222 egg-current-language))
223 (message "egg %s backend: %s" egg-current-language (cadr result))))
224 (setq contin (< e max))
226 (egg-insert-bunsetsu-list bunsetsu-info-list
227 (if (< (point) max) 'contine t)))
231 (defun egg-separate-languages (start end &optional use-context)
232 (let (lang last-lang last-chinese p pe l c cset)
233 ;; 1st pass -- mark undefined Chinese part
236 (setq last-lang (get-text-property (1- (point)) 'egg-lang))
237 (or (equal last-lang "Chinese-GB") (equal last-lang "Chinese-CNS"))
238 (setq last-chinese last-lang))
239 (while (< (point) end)
241 pe (next-single-property-change (point) 'egg-lang nil end))
243 ((get-text-property (point) 'egg-lang)
246 ((setq l (egg-chinese-syllable (buffer-substring p pe)))
248 (setq lang "Chinese"))
250 (setq c (following-char)
251 cset (char-charset c))
252 (eq cset 'chinese-sisheng))
254 (setq lang "Chinese"))
256 (skip-chars-forward "\0-\177" pe)
257 (if (eq (char-charset (following-char)) 'chinese-sisheng)
258 (goto-char (max (1+ pp) (- (point) 6))))
260 ((eq cset 'composition)
262 (setq lang (egg-charset-to-language
263 (char-charset (car (decompose-composite-char c 'list))))))
265 (skip-chars-forward (concat (vector (make-char cset 33 33))
267 (vector (make-char cset 127 127)))
269 (setq lang (egg-charset-to-language cset))))
271 (put-text-property p (point) 'egg-lang lang)))
272 ;; 2nd pass -- set language property
274 (while (< (point) end)
275 (setq lang (get-text-property (point) 'egg-lang))
278 (setq lang (or last-lang
279 (egg-next-part-lang end))))
280 ((equal lang "Chinese")
281 (setq lang (or last-chinese
282 (egg-next-chinese-lang end)))))
283 (setq last-lang lang)
284 (if (or (equal lang "Chinese-GB") (equal lang "Chinese-CNS"))
285 (setq last-chinese lang))
287 (goto-char (next-single-property-change (point) 'egg-lang nil end))
288 (set-text-properties p (point) (list 'egg-lang lang)))))
290 (defun egg-charset-to-language (charset)
291 (let ((list language-info-alist))
293 (null (memq charset (assq 'charset (car list)))))
294 (setq list (cdr list)))
297 (defun egg-next-part-lang (end)
298 (let* ((p (next-single-property-change (point) 'egg-lang nil end))
299 (lang (get-text-property p 'egg-lang)))
300 (if (equal lang "Chinese")
301 (egg-next-chinese-lang end)
304 egg-default-language))))
306 (defun egg-next-chinese-lang (end)
309 (while (and (< p end) (null lang))
310 (setq p (next-single-property-change p 'egg-lang nil end))
311 (setq lang (get-text-property p 'egg-lang))
312 (if (null (or (equal lang "Chinese-GB")
313 (equal lang "Chinese-CNS")))
317 ((or (equal its-current-language "Chinese-GB")
318 (equal its-current-language "Chinese-CNS"))
319 its-current-language)
320 ((or (equal egg-default-language "Chinese-GB")
321 (equal egg-default-language "Chinese-CNS"))
322 egg-default-language)
325 (require 'its-keydef)
327 (defvar egg-conversion-map
328 (let ((map (make-sparse-keymap))
331 (define-key map (vector i) 'egg-exit-conversion-unread-char)
333 (define-key map "\C-@" 'egg-decide-first-char)
334 (define-key map [?\C-\ ] 'egg-decide-first-char)
335 (define-key map "\C-a" 'egg-beginning-of-conversion-buffer)
336 (define-key map "\C-b" 'egg-backward-bunsetsu)
337 (define-key map "\C-c" 'egg-abort-conversion)
338 (define-key map "\C-e" 'egg-end-of-conversion-buffer)
339 (define-key map "\C-f" 'egg-forward-bunsetsu)
340 (define-key map "\C-h" 'egg-help-command)
341 (define-key map "\C-i" 'egg-shrink-bunsetsu)
342 (define-key map "\C-k" 'egg-decide-before-point)
343 ;; (define-key map "\C-l" 'egg-exit-conversion) ; Don't override C-L
344 (define-key map "\C-m" 'egg-exit-conversion)
345 (define-key map "\C-n" 'egg-next-candidate)
346 (define-key map "\C-o" 'egg-enlarge-bunsetsu)
347 (define-key map "\C-p" 'egg-previous-candidate)
348 (define-key map "\C-r" 'egg-reverse-convert-bunsetu)
349 (define-key map "\M-r" 'egg-reconvert-bunsetsu)
350 (define-key map "\M-s" 'egg-select-candidate)
351 (define-key map [return] 'egg-exit-conversion)
352 (define-key map [right] 'egg-forward-bunsetsu)
353 (define-key map [left] 'egg-backward-bunsetsu)
354 (define-key map " " 'egg-next-candidate)
355 (its-define-select-keys map)
357 "Keymap for EGG Conversion mode.")
359 (defun egg-exit-conversion-unread-char ()
361 (setq unread-command-events (list last-command-event))
362 (egg-exit-conversion))
364 (defun egg-insert-bunsetsu (bunsetsu-info last)
365 (let ((bunsetsu (egg-get-bunsetsu-converted bunsetsu-info))
369 (if (null (eq last t))
370 (insert egg-conversion-separator))
371 (set-text-properties p (point)
373 (egg-bunsetsu-info) bunsetsu-info
374 'egg-backend egg-conversion-backend
375 'egg-lang egg-current-language
376 'egg-bunsetsu-last last
377 'local-map egg-conversion-map))
378 (if egg-conversion-face
379 (put-text-property p p1 'face (egg-get-conversion-face)))))
381 (defun egg-insert-bunsetsu-list (bunsetsu-info-list &optional last)
382 (let ((l bunsetsu-info-list)
385 (setq bunsetsu-info (car l)
387 (egg-insert-bunsetsu bunsetsu-info (and (null l) last)))))
389 (defun egg-beginning-of-conversion-buffer (n)
393 (egg-end-of-conversion-buffer 1))
394 ((null (get-text-property (1- (point)) 'egg-start))
395 (goto-char (previous-single-property-change (1- (point)) 'egg-start)))))
397 (defun egg-end-of-conversion-buffer(n)
401 (egg-beginning-of-conversion-buffer 1))
403 (goto-char (next-single-property-change (point) 'egg-end))
406 (defun egg-backward-bunsetsu (n)
409 (while (and (null start) (> n 0))
411 (if (setq start (get-text-property (point) 'egg-start))
415 (signal 'beginning-of-buffer nil))))
417 (defun egg-forward-bunsetsu (n)
420 (while (and (null end) (> n 0))
422 (if (setq end (get-text-property (point) 'egg-end))
426 (signal 'end-of-buffer nil))))
428 (defun egg-get-previous-bunsetsu (p)
429 (and (null (get-text-property (1- p) 'egg-start))
430 (null (get-text-property (1- p) 'egg-bunsetsu-last))
431 (egg-get-bunsetsu-info (- p 2))))
433 (defun egg-separate-characters (str)
434 (let* ((v (string-to-vector str))
436 (i 0) (j 0) m n (nchar 0))
438 (if (setq n (egg-chinese-syllable str j))
439 (setq m (chars-in-string (substring str j (+ j n))))
440 (setq m 1 n (char-bytes (aref v i))))
441 (put-text-property j (+ j n) 'egg-char-size n str)
442 (setq nchar (1+ nchar) i (+ i m) j (+ j n)))
445 (defun egg-shrink-bunsetsu (n)
447 (egg-enlarge-bunsetsu (- n)))
449 (defun egg-enlarge-bunsetsu (n)
451 (let* ((inhibit-read-only t)
452 (b0 (egg-get-previous-bunsetsu (point)))
453 (b1 (egg-get-bunsetsu-info (point)))
454 (s1 (egg-get-bunsetsu-source b1))
455 (s1len (egg-separate-characters s1))
458 (last (get-text-property (point) 'egg-bunsetsu-last))
459 b2 s2 source bunsetsu-info-list beep)
461 (let ((p2 (save-excursion (forward-char) (point))))
462 (setq b2 (egg-get-bunsetsu-info p2)
463 s2 (egg-get-bunsetsu-source b2)
464 s2len (egg-separate-characters s2)
465 last (get-text-property p2 'egg-bunsetsu-last))))
466 (setq source (concat s1 s2))
469 (setq beep t chrs (get-text-property 0 'egg-char-size source)))
471 (setq beep t chrs (length source)))
474 (setq chrs (- chrs (get-text-property (1- chrs) 'egg-char-size source))
478 (setq chrs (+ chrs (get-text-property chrs 'egg-char-size source))
480 (setq bunsetsu-info-list (egg-change-bunsetsu-length b0 b1 b2 chrs))
481 (delete-region (point)
482 (progn (forward-char) (if b2 (forward-char)) (point)))
484 (egg-insert-bunsetsu-list bunsetsu-info-list last)
489 (defun egg-next-candidate (n)
491 (let ((inhibit-read-only t)
492 (last (get-text-property (point) 'egg-bunsetsu-last))
493 (b (egg-get-bunsetsu-info (point)))
495 (setq max+ (egg-get-number-of-candidates b))
497 (let ((prev-b (egg-get-previous-bunsetsu (point))))
498 (setq i (egg-list-candidates b prev-b)) ; there is a case I=/=0
499 (if (or (> n 1) (< n 0)) ; with N=/=1, start with I
500 (setq i (+ n i)) ; or else (N==1),
501 (setq i (if (= i 0) 1 0))) ; I:=1 when I was 0, or else I:=0
502 (setq max+ (egg-get-number-of-candidates b)))
503 (setq i (egg-get-current-candidate-number b))
507 (if (< i 0) ; go backward as if it is ring
509 (setq i (+ i max+))))
510 (if (>= i max+) ; don't go forward
513 (setq new (egg-decide-candidate b i))
515 (delete-region p (progn (forward-char) (point)))
516 (egg-insert-bunsetsu new last)
521 (defun egg-previous-candidate (n)
523 (egg-next-candidate (- n)))
525 (defun egg-reconvert-bunsetsu-internal (n func)
526 (let ((inhibit-read-only t)
528 source last bunsetsu-list)
531 (while (and (null last) (> n 0))
532 (setq source (concat source
533 (egg-get-bunsetsu-converted
534 (egg-get-bunsetsu-info (point))))
535 last (get-text-property (point) 'egg-bunsetsu-last)
541 ((setq bunsetsu-list (funcall func source egg-current-language))
542 (delete-region p (point))
543 (egg-insert-bunsetsu-list bunsetsu-list (if (eq last t) t 'contine))
545 (if (egg-get-previous-bunsetsu p)
548 (put-text-property (point) p 'egg-bunsetsu-last 'contine)
549 (forward-char))))))))
551 (defun egg-reverse-convert-bunsetu (n)
553 (egg-reconvert-bunsetsu-internal n 'egg-start-reverse-conversion))
555 (defun egg-reconvert-bunsetsu (n)
557 (egg-reconvert-bunsetsu-internal n 'egg-start-conversion))
559 (defun egg-decide-before-point ()
561 (let ((inhibit-read-only t)
562 (len (length egg-conversion-open))
563 bunsetsu-list bl (p (point)) source lang s)
565 (if (null (get-text-property (1- (point)) 'egg-start))
566 (goto-char (previous-single-property-change (point) 'egg-start)))
567 (narrow-to-region (- (point) len) p)
568 (setq bunsetsu-list (setq bl (list nil)))
569 (while (< (point) (point-max))
570 ;; delete sparator/open marker
571 (delete-region (- (point) len) (point))
573 bl (setcdr bl (list (egg-get-bunsetsu-info (point)))))
574 (if (get-text-property (point) 'egg-bunsetsu-last)
576 (egg-end-conversion (cdr bunsetsu-list))
577 (setq bunsetsu-list (setq bl (list nil)))))
580 (set-text-properties p (point) nil)))
581 (if (cdr bunsetsu-list)
582 (egg-end-conversion (cdr bunsetsu-list)))
583 (if (get-text-property (point) 'egg-end)
585 ;; delete close marker
586 (delete-region (point) (+ (point) (length egg-conversion-close)))
588 (run-hooks 'input-method-after-insert-chunk-hook))
589 ;; delete from last speparater
590 (delete-region (1- (point)) (point))
592 (while (null (get-text-property (point) 'egg-end))
593 (setq s (egg-get-bunsetsu-source (egg-get-bunsetsu-info (point))))
594 (put-text-property 0 (length s) 'egg-lang egg-current-language s)
595 (setq source (concat source s))
598 (delete-region p (point)))
599 ;; delete close marker
600 (delete-region (point) (+ (point) (length egg-conversion-close)))
601 (its-restart source t))))
603 (defun egg-exit-conversion ()
605 (goto-char (next-single-property-change (point) 'egg-end))
606 (egg-decide-before-point))
608 (defun egg-abort-conversion ()
610 (let ((inhibit-read-only t) source)
611 (goto-char (- (if (get-text-property (1- (point)) 'egg-start)
613 (previous-single-property-change (point) 'egg-start))
614 (length egg-conversion-open)))
615 (setq source (get-text-property (point) 'egg-source))
616 (delete-region (point) (+ (next-single-property-change (point) 'egg-end)
617 (length egg-conversion-close)))
618 (its-restart source)))
620 (defun egg-select-candidate ()
622 (let ((inhibit-read-only t)
623 (last (get-text-property (point) 'egg-bunsetsu-last))
624 (b (egg-get-bunsetsu-info (point)))
627 (setq max+ (egg-get-number-of-candidates b))
629 (let ((prev-b (egg-get-previous-bunsetsu (point))))
630 (setq i (egg-list-candidates b prev-b))
631 (setq max+ (egg-get-number-of-candidates b)))
632 (setq i (egg-get-current-candidate-number b)))
633 (let (candidate-list candidate l)
636 (menudiag-select (list 'menu "
\e$B8uJd
\e(B:"
637 (list (egg-get-bunsetsu-converted b))
638 (list (egg-get-bunsetsu-converted b))))
639 (setq candidate-list (egg-get-all-candidates b)
641 candidate (menudiag-select (list 'menu "
\e$B8uJd
\e(B:" l)
645 (if (eq candidate (car l))
649 (setq new (egg-decide-candidate b i))
651 (delete-region p (progn (forward-char) (point)))
652 (egg-insert-bunsetsu new last)
656 ;;; egg-cnv.el ends here.