1 ;;; egg-mlh.el --- Modeless Conversion Facility in Egg Input
2 ;;; Method Architecture
4 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
8 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
9 ;; KATAYAMA Yoshio <kate@pfu.co.jp> ; Multilingual Enhancement
10 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
11 ;; Keywords: mule, multilingual, input method
13 ;; This file is part of EGG.
15 ;; EGG is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
20 ;; EGG is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
31 ;; Once written by NIIBE Yutaka in mlh-1.002 distribution.
32 ;; Then, assigned to Mule Project.
36 (defvar mlh-default-backend "wnn")
38 (defun mlh-space-bar-backward-henkan ()
39 "If the character preceding point is / (slash),
40 Do `mlh-backward-henkan'. Then, invoke appropriate conversion, if needed.
41 Or else, execute command that space-bar invokes usually."
43 (let ((henkan-begin nil)
45 (its-disable-special-action t))
46 (if (null (assq 'Japanese egg-conversion-backend-alist))
48 (setq egg-mode-preference nil)
49 (activate-input-method (concat "japanese-egg-" mlh-default-backend)))
51 (its-select-hiragana))
54 (if (or inhibit-henkan (= henkan-begin (point)))
57 (message "Converting...")
59 (egg-convert-region henkan-begin (point))
61 (setq this-command 'self-insert-command)
62 (call-interactively 'self-insert-command))))
64 (defvar mlh-punctuations nil)
67 (setq mlh-punctuations "!()?;:"))
69 (defvar mlh-conversion-scheme-table
86 (?d . mlh-user-defined-conversion)
97 ; (?n . mlh-no-conversion)
99 (?p . mlh-upcase-letter)
102 (?s . mlh-small-letter)
103 (?t . mlh-zhongwen-tw)
106 (?w . mlh-white-space)
110 (?H . mlh-hiragana-to-kanji)
111 (?L . mlh-lisp-expression)
112 (?W . mlh-zenkaku-white)
117 (defun mlh-zenkaku-white ()
119 (skip-chars-backward "0-9")
120 (mlh-backward-henkan)
122 (goto-char end-marker)
123 (backward-delete-char 2)
124 (let* ((str (buffer-substring beg (point)))
125 (val (string-to-int str)))
126 (delete-region beg (point))
130 (insert "
\e$B!!
\e(B")
131 (setq val (1- val))))
132 (if (null henkan-begin)
133 (setq henkan-begin beg)))
136 (goto-char end-marker)
137 (backward-delete-char 2)
139 (setq henkan-begin (point)))
141 (defun mlh-upcase-letter ()
143 (skip-chars-backward "a-zA-Z0-9")
144 (mlh-backward-henkan)
146 (goto-char end-marker)
147 (backward-delete-char 2)
148 (upcase-region beg (point))
149 (if (null henkan-begin)
150 (setq henkan-begin beg)))
152 (defun mlh-capitalize ()
154 (skip-chars-backward "a-zA-Z1-9")
155 (mlh-backward-henkan)
157 (goto-char end-marker)
158 (backward-delete-char 2)
159 (capitalize-region beg (point))
160 (if (null henkan-begin)
161 (setq henkan-begin beg)))
163 (defun mlh-jis-code ()
165 (skip-chars-backward "0-9a-fA-F")
166 (mlh-backward-henkan)
168 (goto-char end-marker)
169 (backward-delete-char 2)
170 (let* ((str (buffer-substring beg (point)))
171 (val (read-jis-code-from-string str)))
172 ;; ^--- this function is in egg.el
173 (delete-region beg (point))
175 (insert (make-character lc-jp (car val) (cdr val)))
177 (if (null henkan-begin)
178 (setq henkan-begin beg)))
180 (defun mlh-lisp-expression ()
182 (let ((stab (syntax-table)))
185 (set-syntax-table emacs-lisp-mode-syntax-table)
187 (set-syntax-table stab)))
188 (mlh-backward-henkan)
190 (goto-char end-marker)
191 (backward-delete-char 2)
193 (buffer-substring beg (point)))
194 (exp (car (read-from-string exp-str)))
196 (delete-region beg (point))
197 (insert (format "%s" result)))
198 (if (null henkan-begin)
199 (setq henkan-begin beg)))
202 (goto-char end-marker)
203 (backward-delete-char 2)
204 (setq henkan-begin (point)))
206 (defun mlh-no-conversion ()
208 (skip-chars-backward "\041-\056\060-\176")
209 (mlh-backward-henkan)
211 (goto-char end-marker)
212 (backward-delete-char 2)
213 (if (null henkan-begin)
214 (setq henkan-begin beg)))
216 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
218 (defun mlh-white-space ()
220 (skip-chars-backward "0-9")
221 (mlh-backward-henkan)
223 (goto-char end-marker)
224 (backward-delete-char 2)
225 (let* ((str (buffer-substring beg (point)))
226 (val (string-to-int str)))
227 (delete-region beg (point))
230 (insert (make-string val ?\ )))
231 (if (null henkan-begin)
232 (setq henkan-begin beg)))
234 (defun mlh-execute ()
236 (if (fboundp 'mlh-userdef-function)
237 (mlh-userdef-function)
238 (mlh-backward-henkan)
240 (goto-char end-marker)
241 (backward-delete-char 2)
242 (if (null henkan-begin)
243 (setq henkan-begin beg))))
245 (defun mlh-backward-henkan ()
246 "For each words seperated by / (slash), do conversion.
247 Accoding to a character preceding slash, conversion scheme are selected.
249 CHAR. MNEMONIC CONVERSION SCHEME
251 H Hiragana to kanji Convert Hiragana to Kanji
252 L Lisp Evaluate as Emacs-Lisp expression
253 W zenkaku White space Insert Zenkaku spaces
254 X eXit Quit going backward, insert space
255 Z Zenkaku Convert to Zenkaku
256 c Capitalize Capitalize
257 d user Definition Convert with user definition table
258 f Firagana ?? Convert to Hiragana
259 g Greek letter Convert to single greek letter
260 h Hangul Convert to Hangul
261 j Jis-code Convert to character which has code
262 k Katakana Convert to Katakana
263 l Ligature Ligature (not implemented yet)
264 p uPcase letter uPcase
265 q Quit Quit going backward
266 s Small letter No conversion
267 w White space Insert spaces
268 x eXecute Call user defined function
269 z Zhongwen Convert to Zhongwen
270 OTHERWISE Convert to KANJI
272 (if (eq (preceding-char) ?/)
273 (let ((end-marker (point-marker))
276 (set-marker-insertion-type end-marker t)
280 (setq char (preceding-char))
282 ((setq scheme (assq char mlh-conversion-scheme-table))
283 (funcall (cdr scheme)))
285 (goto-char end-marker)))
290 (goto-char end-marker))))
291 (set-marker end-marker nil)))))
294 (defvar mlh-syntax-table nil
295 "Syntax table of mlh, which are used to determine spacing.")
298 (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
299 (modify-syntax-entry ?! "." mlh-syntax-table)
300 (modify-syntax-entry ?$ "'" mlh-syntax-table)
301 (modify-syntax-entry ?% "'" mlh-syntax-table)
302 (modify-syntax-entry ?& "'" mlh-syntax-table)
303 (modify-syntax-entry ?{ "(}" mlh-syntax-table)
304 (modify-syntax-entry ?} "){" mlh-syntax-table)
307 ;;; XXX RTFM, gniibe!
308 (defvar mlh-space-control
310 (("al".?w).("al".?w))
311 (("al".?w).("al".?_))
312 (("al".?w).("Hj|".?e))
313 (("al".?w).("Cj|".?e))
314 (("al".?_).("al".?w))
315 (("al".?_).("al".?_))
316 (("al".?_).("Hj|".?e))
317 (("al".?_).("Cj|".?e))
318 (("al".?.).("al".?w))
319 (("al".?.).("al".?_))
320 (("al".?_).("Hj|".?e))
321 (("al".?_).("Cj|".?e))
322 (("Hj|".?e).("al".?w))
323 (("Cj|".?e).("al".?w))
324 (("Hj|".?e).("al".?_))
325 (("Cj|".?e).("al".?_))
327 "Alist that determines inserting space.")
329 (defun mlh-do-spacing ()
330 "Arrange spacing as you like."
333 (let ((s-tab (syntax-table))
338 (set-syntax-table mlh-syntax-table)
339 (setq s-pc (char-syntax (preceding-char))
340 s-fc (char-syntax (following-char))))
341 (set-syntax-table s-tab))
342 (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
343 c-fc (category-set-mnemonics (char-category-set (following-char))))
344 (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
347 (>= henkan-begin (point))
348 (setq henkan-begin (1+ henkan-begin)))
351 (defvar mlh-select-mode-map (make-keymap))
353 ;;; acutually this map is not necessary now. for future extention
354 (defvar mlh-select-mode-esc-map (make-keymap))
356 (define-key mlh-select-mode-map [t] 'undefined)
357 (define-key mlh-select-mode-esc-map [t] 'undefined)
361 (define-key mlh-select-mode-map (char-to-string ch)
362 'mlh-select-kakutei-and-self-insert)
365 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
366 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
367 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
368 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
369 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
370 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
372 (if (eq window-system 'x)
374 (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
375 (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
378 (defun mlh-select-insert-candidate (n)
379 (delete-region beg (point))
380 (insert (nth n candidates)))
382 (defun mlh-select-prev-candidate ()
384 (setq current-candidate (1- current-candidate))
385 (if (< current-candidate 0)
386 (setq current-candidate (1- number-of-candidates)))
387 (mlh-select-insert-candidate current-candidate))
389 (defun mlh-select-next-candidate ()
391 (setq current-candidate (1+ current-candidate))
392 (if (>= current-candidate number-of-candidates)
393 (setq current-candidate 0))
394 (mlh-select-insert-candidate current-candidate))
396 (defun mlh-recursive-edit-select (beg end candidates)
397 (mlh-select-insert-candidate 0)
398 (and (boundp 'disable-undo) (setq disable-undo t))
399 (let ((old-local-map (current-local-map))
400 (number-of-candidates (length candidates))
401 (current-candidate 0))
402 (use-local-map mlh-select-mode-map)
404 (use-local-map old-local-map)))
406 (defun mlh-select-kakutei-and-self-insert ()
408 (setq unread-command-events (list last-command-event))
409 (mlh-select-kakutei))
411 (defun mlh-select-kakutei ()
413 (and (boundp 'disable-undo) (setq disable-undo nil))
414 (exit-recursive-edit))
416 (defun mlh-user-defined-conversion ()
418 (skip-chars-backward "-a-zA-Z")
419 (mlh-backward-henkan)
421 (goto-char end-marker)
422 (backward-delete-char 2)
423 (let* ((str (buffer-substring beg (point)))
424 (userdef (mlh-userdef<==string str)))
425 (cond ((stringp userdef)
426 (delete-region beg (point))
429 (delete-region beg (point))
430 ;; (add-userdef) (insert new-userdef)
433 (mlh-recursive-edit-select beg (point) userdef))))
434 (if (null henkan-begin)
435 (setq henkan-begin beg)))
437 (defvar mlh-userdef-table nil
438 "Convertion table of words(string) to another words(string).")
440 (defun mlh-userdef<==string (str)
441 "Convert string to another string with `mlh-userdef-table'"
442 (cdr (assoc str mlh-userdef-table)))
444 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
447 (funcall mlh-kanji-function))
449 (defun mlh-kanji-with-henkan-region-function ()
450 (skip-chars-backward "-a-z,.'N[]")
451 (mlh-backward-henkan)
452 (setq inhibit-henkan nil)
454 (goto-char end-marker)
456 (its-translate-region-internal beg (point))
457 (delete-region (point) end-marker)
458 (if (null henkan-begin)
459 (setq henkan-begin beg)))
461 (defun mlh-hiragana ()
463 (skip-chars-backward "-a-z,.'N[]")
464 (mlh-backward-henkan)
466 (goto-char end-marker)
468 (its-translate-region-internal beg (point))
469 (delete-region (point) end-marker)
470 (setq henkan-begin (point)))
472 (defun mlh-hiragana-to-kanji ()
474 (skip-chars-backward "
\e$B$!
\e(B-
\e$B$s!<
\e(B")
475 (mlh-backward-henkan)
477 (setq inhibit-henkan nil)
478 (goto-char end-marker)
479 (backward-delete-char 2)
480 (if (null henkan-begin)
481 (setq henkan-begin beg)))
483 (defun mlh-katakana ()
485 (skip-chars-backward "-a-z,.'N[]")
486 (mlh-backward-henkan)
488 (goto-char end-marker)
490 (its-translate-region-internal beg (point))
491 (insert (mlh-hira-to-kata
493 (buffer-substring beg (point))
494 (delete-region beg (point)))))
495 (delete-region (point) end-marker)
496 (if (null henkan-begin)
497 (setq henkan-begin beg)))
499 (defun mlh-zenkaku ()
501 (skip-chars-backward "\041-\056\060-\176")
502 (mlh-backward-henkan)
504 (goto-char end-marker)
505 (backward-delete-char 2)
506 (japanese-zenkaku-region beg (point))
507 (if (null henkan-begin)
508 (setq henkan-begin beg)))
510 (defun mlh-hira-to-kata (str)
511 "Convert hiragana to katakana in STR."
512 (let ((result (copy-sequence str))
514 (while (setq i (string-match "[
\e$B$!
\e(B-
\e$B$s
\e(B]" str i))
515 (aset result (1+ i) ?\245)
521 (skip-chars-backward "a-zEO-RTW,.[]")
522 (mlh-backward-henkan)
524 (setq inhibit-henkan nil)
525 (goto-char end-marker)
527 (let (its-current-map its-current-language)
528 (its-select-hangul t)
529 (its-translate-region-internal beg (point)))
530 (delete-region (point) end-marker)
531 (if (null henkan-begin)
532 (setq henkan-begin beg)))
534 (defun mlh-zhongwen ()
536 (skip-chars-backward "a-z0-4 ,.[]")
537 (mlh-backward-henkan)
539 (setq inhibit-henkan nil)
540 (goto-char end-marker)
542 (let (its-current-map its-current-language)
543 (its-select-pinyin-cn t)
544 (its-translate-region-internal beg (point)))
545 (delete-region (point) end-marker)
546 (if (null henkan-begin)
547 (setq henkan-begin beg)))
549 (defun mlh-zhongwen-tw ()
551 (skip-chars-backward "a-z0-4,.[]")
552 (mlh-backward-henkan)
554 (setq inhibit-henkan nil)
555 (goto-char end-marker)
557 (let (its-current-map its-current-language)
558 (its-select-pinyin-tw t)
559 (its-translate-region-internal beg (point)))
560 (delete-region (point) end-marker)
561 (if (null henkan-begin)
562 (setq henkan-begin beg)))
565 ;;; egg-mlh.el ends here.