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 will be part of GNU Emacs (in future).
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 (defun mlh-space-bar-backward-henkan ()
37 "If the character preceding point is / (slash),
38 Do `mlh-backward-henkan'. Then, invoke appropriate conversion, if needed.
39 Or else, execute command that space-bar invokes usually."
41 (let ((henkan-begin nil)
43 (its-select-hiragana) ;; force to Japanese
46 (if (or inhibit-henkan (= henkan-begin (point)))
49 (message "Converting...")
51 (egg-convert-region henkan-begin (point))
53 (setq this-command 'self-insert-command)
54 (call-interactively 'self-insert-command))))
56 (defvar mlh-punctuations nil)
59 (setq mlh-punctuations "!()?;:"))
61 (defvar mlh-conversion-scheme-table
78 (?d . mlh-user-defined-conversion)
89 ; (?n . mlh-no-conversion)
91 (?p . mlh-upcase-letter)
94 (?s . mlh-small-letter)
95 (?t . mlh-zhongwen-tw)
98 (?w . mlh-white-space)
102 (?H . mlh-hiragana-to-kanji)
103 (?L . mlh-lisp-expression)
104 (?W . mlh-zenkaku-white)
109 (defun mlh-zenkaku-white ()
111 (skip-chars-backward "0-9")
112 (mlh-backward-henkan)
114 (goto-char end-marker)
115 (backward-delete-char 2)
116 (let* ((str (buffer-substring beg (point)))
117 (val (string-to-int str)))
118 (delete-region beg (point))
122 (insert "
\e$B!!
\e(B")
123 (setq val (1- val))))
124 (if (null henkan-begin)
125 (setq henkan-begin beg)))
128 (goto-char end-marker)
129 (backward-delete-char 2)
131 (setq henkan-begin (point)))
133 (defun mlh-upcase-letter ()
135 (skip-chars-backward "a-zA-Z0-9")
136 (mlh-backward-henkan)
138 (goto-char end-marker)
139 (backward-delete-char 2)
140 (upcase-region beg (point))
141 (if (null henkan-begin)
142 (setq henkan-begin beg)))
144 (defun mlh-capitalize ()
146 (skip-chars-backward "a-zA-Z1-9")
147 (mlh-backward-henkan)
149 (goto-char end-marker)
150 (backward-delete-char 2)
151 (capitalize-region beg (point))
152 (if (null henkan-begin)
153 (setq henkan-begin beg)))
155 (defun mlh-jis-code ()
157 (skip-chars-backward "0-9a-fA-F")
158 (mlh-backward-henkan)
160 (goto-char end-marker)
161 (backward-delete-char 2)
162 (let* ((str (buffer-substring beg (point)))
163 (val (read-jis-code-from-string str)))
164 ;; ^--- this function is in egg.el
165 (delete-region beg (point))
167 (insert (make-character lc-jp (car val) (cdr val)))
169 (if (null henkan-begin)
170 (setq henkan-begin beg)))
172 (defun mlh-lisp-expression ()
174 (let ((stab (syntax-table)))
177 (set-syntax-table emacs-lisp-mode-syntax-table)
179 (set-syntax-table stab)))
180 (mlh-backward-henkan)
182 (goto-char end-marker)
183 (backward-delete-char 2)
185 (buffer-substring beg (point)))
186 (exp (car (read-from-string exp-str)))
188 (delete-region beg (point))
189 (insert (format "%s" result)))
190 (if (null henkan-begin)
191 (setq henkan-begin beg)))
194 (goto-char end-marker)
195 (backward-delete-char 2)
196 (setq henkan-begin (point)))
198 (defun mlh-no-conversion ()
200 (skip-chars-backward "\041-\056\060-\176")
201 (mlh-backward-henkan)
203 (goto-char end-marker)
204 (backward-delete-char 2)
205 (if (null henkan-begin)
206 (setq henkan-begin beg)))
208 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
210 (defun mlh-white-space ()
212 (skip-chars-backward "0-9")
213 (mlh-backward-henkan)
215 (goto-char end-marker)
216 (backward-delete-char 2)
217 (let* ((str (buffer-substring beg (point)))
218 (val (string-to-int str)))
219 (delete-region beg (point))
222 (insert (make-string val ?\ )))
223 (if (null henkan-begin)
224 (setq henkan-begin beg)))
226 (defun mlh-execute ()
228 (if (fboundp 'mlh-userdef-function)
229 (mlh-userdef-function)
230 (mlh-backward-henkan)
232 (goto-char end-marker)
233 (backward-delete-char 2)
234 (if (null henkan-begin)
235 (setq henkan-begin beg))))
237 (defun mlh-backward-henkan ()
238 "For each words seperated by / (slash), do conversion.
239 Accoding to a character preceding slash, conversion scheme are selected.
241 CHAR. MNEMONIC CONVERSION SCHEME
243 H Hiragana to kanji Convert Hiragana to Kanji
244 L Lisp Evaluate as Emacs-Lisp expression
245 W zenkaku White space Insert Zenkaku spaces
246 X eXit Quit going backward, insert space
247 Z Zenkaku Convert to Zenkaku
248 c Capitalize Capitalize
249 d user Definition Convert with user definition table
250 f Firagana ?? Convert to Hiragana
251 g Greek letter Convert to single greek letter
252 h Hangul Convert to Hangul
253 j Jis-code Convert to character which has code
254 k Katakana Convert to Katakana
255 l Ligature Ligature (not implemented yet)
256 p uPcase letter uPcase
257 q Quit Quit going backward
258 s Small letter No conversion
259 w White space Insert spaces
260 x eXecute Call user defined function
261 z Zhongwen Convert to Zhongwen
262 OTHERWISE Convert to KANJI
264 (if (eq (preceding-char) ?/)
265 (let ((end-marker (point-marker))
268 (set-marker-insertion-type end-marker t)
272 (setq char (preceding-char))
274 ((setq scheme (assq char mlh-conversion-scheme-table))
275 (funcall (cdr scheme)))
277 (goto-char end-marker)))
282 (goto-char end-marker))))
283 (set-marker end-marker nil)))))
286 (defvar mlh-syntax-table nil
287 "Syntax table of mlh, which are used to determine spacing.")
290 (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
291 (modify-syntax-entry ?! "." mlh-syntax-table)
292 (modify-syntax-entry ?$ "'" mlh-syntax-table)
293 (modify-syntax-entry ?% "'" mlh-syntax-table)
294 (modify-syntax-entry ?& "'" mlh-syntax-table)
295 (modify-syntax-entry ?{ "(}" mlh-syntax-table)
296 (modify-syntax-entry ?} "){" mlh-syntax-table)
299 ;;; XXX RTFM, gniibe!
300 (defvar mlh-space-control
302 (("al".?w).("al".?w))
303 (("al".?w).("al".?_))
304 (("al".?w).("Hj|".?e))
305 (("al".?w).("Cj|".?e))
306 (("al".?_).("al".?w))
307 (("al".?_).("al".?_))
308 (("al".?_).("Hj|".?e))
309 (("al".?_).("Cj|".?e))
310 (("al".?.).("al".?w))
311 (("al".?.).("al".?_))
312 (("al".?_).("Hj|".?e))
313 (("al".?_).("Cj|".?e))
314 (("Hj|".?e).("al".?w))
315 (("Cj|".?e).("al".?w))
316 (("Hj|".?e).("al".?_))
317 (("Cj|".?e).("al".?_))
319 "Alist that determines inserting space.")
321 (defun mlh-do-spacing ()
322 "Arrange spacing as you like."
325 (let ((s-tab (syntax-table))
330 (set-syntax-table mlh-syntax-table)
331 (setq s-pc (char-syntax (preceding-char))
332 s-fc (char-syntax (following-char))))
333 (set-syntax-table s-tab))
334 (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
335 c-fc (category-set-mnemonics (char-category-set (following-char))))
336 (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
339 (>= henkan-begin (point))
340 (setq henkan-begin (1+ henkan-begin)))
343 (defvar mlh-select-mode-map (make-keymap))
345 ;;; acutually this map is not necessary now. for future extention
346 (defvar mlh-select-mode-esc-map (make-keymap))
348 (define-key mlh-select-mode-map [t] 'undefined)
349 (define-key mlh-select-mode-esc-map [t] 'undefined)
353 (define-key mlh-select-mode-map (char-to-string ch)
354 'mlh-select-kakutei-and-self-insert)
357 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
358 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
359 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
360 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
361 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
362 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
364 (if (eq window-system 'x)
366 (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
367 (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
370 (defun mlh-select-insert-candidate (n)
371 (delete-region beg (point))
372 (insert (nth n candidates)))
374 (defun mlh-select-prev-candidate ()
376 (setq current-candidate (1- current-candidate))
377 (if (< current-candidate 0)
378 (setq current-candidate (1- number-of-candidates)))
379 (mlh-select-insert-candidate current-candidate))
381 (defun mlh-select-next-candidate ()
383 (setq current-candidate (1+ current-candidate))
384 (if (>= current-candidate number-of-candidates)
385 (setq current-candidate 0))
386 (mlh-select-insert-candidate current-candidate))
388 (defun mlh-recursive-edit-select (beg end candidates)
389 (mlh-select-insert-candidate 0)
390 (and (boundp 'disable-undo) (setq disable-undo t))
391 (let ((old-local-map (current-local-map))
392 (number-of-candidates (length candidates))
393 (current-candidate 0))
394 (use-local-map mlh-select-mode-map)
396 (use-local-map old-local-map)))
398 (defun mlh-select-kakutei-and-self-insert ()
400 (setq unread-command-events (list last-command-event))
401 (mlh-select-kakutei))
403 (defun mlh-select-kakutei ()
405 (and (boundp 'disable-undo) (setq disable-undo nil))
406 (exit-recursive-edit))
408 (defun mlh-user-defined-conversion ()
410 (skip-chars-backward "-a-zA-Z")
411 (mlh-backward-henkan)
413 (goto-char end-marker)
414 (backward-delete-char 2)
415 (let* ((str (buffer-substring beg (point)))
416 (userdef (mlh-userdef<==string str)))
417 (cond ((stringp userdef)
418 (delete-region beg (point))
421 (delete-region beg (point))
422 ;; (add-userdef) (insert new-userdef)
425 (mlh-recursive-edit-select beg (point) userdef))))
426 (if (null henkan-begin)
427 (setq henkan-begin beg)))
429 (defvar mlh-userdef-table nil
430 "Convertion table of words(string) to another words(string).")
432 (defun mlh-userdef<==string (str)
433 "Convert string to another string with `mlh-userdef-table'"
434 (cdr (assoc str mlh-userdef-table)))
436 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
439 (funcall mlh-kanji-function))
441 (defun mlh-kanji-with-henkan-region-function ()
442 (skip-chars-backward "-a-z,.'N[]")
443 (mlh-backward-henkan)
444 (setq inhibit-henkan nil)
446 (goto-char end-marker)
448 (its-translate-region-internal beg (point))
449 (delete-region (point) end-marker)
450 (if (null henkan-begin)
451 (setq henkan-begin beg)))
453 (defun mlh-hiragana ()
455 (skip-chars-backward "-a-z,.'N[]")
456 (mlh-backward-henkan)
458 (goto-char end-marker)
460 (its-translate-region-internal beg (point))
461 (delete-region (point) end-marker)
462 (setq henkan-begin (point)))
464 (defun mlh-hiragana-to-kanji ()
466 (skip-chars-backward "
\e$B$!
\e(B-
\e$B$s!<
\e(B")
467 (mlh-backward-henkan)
469 (setq inhibit-henkan nil)
470 (goto-char end-marker)
471 (backward-delete-char 2)
472 (if (null henkan-begin)
473 (setq henkan-begin beg)))
475 (defun mlh-katakana ()
477 (skip-chars-backward "-a-z,.'N[]")
478 (mlh-backward-henkan)
480 (goto-char end-marker)
482 (its-translate-region-internal beg (point))
483 (insert (mlh-hira-to-kata
485 (buffer-substring beg (point))
486 (delete-region beg (point)))))
487 (delete-region (point) end-marker)
488 (if (null henkan-begin)
489 (setq henkan-begin beg)))
491 (defun mlh-zenkaku ()
493 (skip-chars-backward "\041-\056\060-\176")
494 (mlh-backward-henkan)
496 (goto-char end-marker)
497 (backward-delete-char 2)
498 (japanese-zenkaku-region beg (point))
499 (if (null henkan-begin)
500 (setq henkan-begin beg)))
502 (defun mlh-hira-to-kata (str)
503 "Convert hiragana to katakana in STR."
504 (let ((result (copy-sequence str))
506 (while (setq i (string-match "[
\e$B$!
\e(B-
\e$B$s
\e(B]" str i))
507 (aset result (1+ i) ?\245)
513 (skip-chars-backward "a-zEO-RTW,.[]")
514 (mlh-backward-henkan)
516 (setq inhibit-henkan nil)
517 (goto-char end-marker)
519 (let (its-current-map its-current-language)
520 (its-select-hangul t)
521 (its-translate-region-internal beg (point)))
522 (delete-region (point) end-marker)
523 (if (null henkan-begin)
524 (setq henkan-begin beg)))
526 (defun mlh-zhongwen ()
528 (skip-chars-backward "a-z0-4 ,.[]")
529 (mlh-backward-henkan)
531 (setq inhibit-henkan nil)
532 (goto-char end-marker)
534 (let (its-current-map its-current-language)
535 (its-select-pinyin-cn t)
536 (its-translate-region-internal beg (point)))
537 (delete-region (point) end-marker)
538 (if (null henkan-begin)
539 (setq henkan-begin beg)))
541 (defun mlh-zhongwen-tw ()
543 (skip-chars-backward "a-z0-4,.[]")
544 (mlh-backward-henkan)
546 (setq inhibit-henkan nil)
547 (goto-char end-marker)
549 (let (its-current-map its-current-language)
550 (its-select-pinyin-tw t)
551 (its-translate-region-internal beg (point)))
552 (delete-region (point) end-marker)
553 (if (null henkan-begin)
554 (setq henkan-begin beg)))
557 ;;; egg-mlh.el ends here.