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 ;; 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.
30 ;; Once written by NIIBE Yutaka in mlh-1.002 distribution.
31 ;; Then, assigned to Mule Project.
35 (defun mlh-space-bar-backward-henkan ()
36 "If the character preceding point is / (slash),
37 Do `mlh-backward-henkan'. Then, invoke appropriate conversion, if needed.
38 Or else, execute command that space-bar invokes usually."
40 (let ((henkan-begin nil)
42 (its-select-hiragana) ;; force to Japanese
45 (if (or inhibit-henkan (= henkan-begin (point)))
48 (message "Converting...")
50 (egg-convert-region henkan-begin (point))
52 (setq this-command 'self-insert-command)
53 (call-interactively 'self-insert-command))))
55 (defvar mlh-punctuations nil)
58 (setq mlh-punctuations "!()?;:"))
60 (defvar mlh-conversion-scheme-table
77 (?d . mlh-user-defined-conversion)
88 ; (?n . mlh-no-conversion)
90 (?p . mlh-upcase-letter)
93 (?s . mlh-small-letter)
94 (?t . mlh-zhongwen-tw)
97 (?w . mlh-white-space)
101 (?H . mlh-hiragana-to-kanji)
102 (?L . mlh-lisp-expression)
103 (?W . mlh-zenkaku-white)
108 (defun mlh-zenkaku-white ()
110 (skip-chars-backward "0-9")
111 (mlh-backward-henkan)
113 (goto-char end-marker)
114 (backward-delete-char 2)
115 (let* ((str (buffer-substring beg (point)))
116 (val (string-to-int str)))
117 (delete-region beg (point))
121 (insert "
\e$B!!
\e(B")
122 (setq val (1- val))))
123 (if (null henkan-begin)
124 (setq henkan-begin beg)))
127 (goto-char end-marker)
128 (backward-delete-char 2)
130 (setq henkan-begin (point)))
132 (defun mlh-upcase-letter ()
134 (skip-chars-backward "a-zA-Z0-9")
135 (mlh-backward-henkan)
137 (goto-char end-marker)
138 (backward-delete-char 2)
139 (upcase-region beg (point))
140 (if (null henkan-begin)
141 (setq henkan-begin beg)))
143 (defun mlh-capitalize ()
145 (skip-chars-backward "a-zA-Z1-9")
146 (mlh-backward-henkan)
148 (goto-char end-marker)
149 (backward-delete-char 2)
150 (capitalize-region beg (point))
151 (if (null henkan-begin)
152 (setq henkan-begin beg)))
154 (defun mlh-jis-code ()
156 (skip-chars-backward "0-9a-fA-F")
157 (mlh-backward-henkan)
159 (goto-char end-marker)
160 (backward-delete-char 2)
161 (let* ((str (buffer-substring beg (point)))
162 (val (read-jis-code-from-string str)))
163 ;; ^--- this function is in egg.el
164 (delete-region beg (point))
166 (insert (make-character lc-jp (car val) (cdr val)))
168 (if (null henkan-begin)
169 (setq henkan-begin beg)))
171 (defun mlh-lisp-expression ()
173 (let ((stab (syntax-table)))
176 (set-syntax-table emacs-lisp-mode-syntax-table)
178 (set-syntax-table stab)))
179 (mlh-backward-henkan)
181 (goto-char end-marker)
182 (backward-delete-char 2)
184 (buffer-substring beg (point)))
185 (exp (car (read-from-string exp-str)))
187 (delete-region beg (point))
188 (insert (format "%s" result)))
189 (if (null henkan-begin)
190 (setq henkan-begin beg)))
193 (goto-char end-marker)
194 (backward-delete-char 2)
195 (setq henkan-begin (point)))
197 (defun mlh-no-conversion ()
199 (skip-chars-backward "\041-\056\060-\176")
200 (mlh-backward-henkan)
202 (goto-char end-marker)
203 (backward-delete-char 2)
204 (if (null henkan-begin)
205 (setq henkan-begin beg)))
207 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
209 (defun mlh-white-space ()
211 (skip-chars-backward "0-9")
212 (mlh-backward-henkan)
214 (goto-char end-marker)
215 (backward-delete-char 2)
216 (let* ((str (buffer-substring beg (point)))
217 (val (string-to-int str)))
218 (delete-region beg (point))
221 (insert (make-string val ?\ )))
222 (if (null henkan-begin)
223 (setq henkan-begin beg)))
225 (defun mlh-execute ()
227 (if (fboundp 'mlh-userdef-function)
228 (mlh-userdef-function)
229 (mlh-backward-henkan)
231 (goto-char end-marker)
232 (backward-delete-char 2)
233 (if (null henkan-begin)
234 (setq henkan-begin beg))))
236 (defun mlh-backward-henkan ()
237 "For each words seperated by / (slash), do conversion.
238 Accoding to a character preceding slash, conversion scheme are selected.
240 CHAR. MNEMONIC CONVERSION SCHEME
242 H Hiragana to kanji Convert Hiragana to Kanji
243 L Lisp Evaluate as Emacs-Lisp expression
244 W zenkaku White space Insert Zenkaku spaces
245 X eXit Quit going backward, insert space
246 Z Zenkaku Convert to Zenkaku
247 c Capitalize Capitalize
248 d user Definition Convert with user definition table
249 f Firagana ?? Convert to Hiragana
250 g Greek letter Convert to single greek letter
251 h Hangul Convert to Hangul
252 j Jis-code Convert to character which has code
253 k Katakana Convert to Katakana
254 l Ligature Ligature (not implemented yet)
255 p uPcase letter uPcase
256 q Quit Quit going backward
257 s Small letter No conversion
258 w White space Insert spaces
259 x eXecute Call user defined function
260 z Zhongwen Convert to Zhongwen
261 OTHERWISE Convert to KANJI
263 (if (eq (preceding-char) ?/)
264 (let ((end-marker (point-marker))
267 (set-marker-insertion-type end-marker t)
271 (setq char (preceding-char))
273 ((setq scheme (assq char mlh-conversion-scheme-table))
274 (funcall (cdr scheme)))
276 (goto-char end-marker)))
281 (goto-char end-marker))))
282 (set-marker end-marker nil)))))
285 (defvar mlh-syntax-table nil
286 "Syntax table of mlh, which are used to determine spacing.")
289 (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
290 (modify-syntax-entry ?! "." mlh-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)
298 ;;; XXX RTFM, gniibe!
299 (defvar mlh-space-control
301 (("al".?w).("al".?w))
302 (("al".?w).("al".?_))
303 (("al".?w).("Hj|".?e))
304 (("al".?w).("Cj|".?e))
305 (("al".?_).("al".?w))
306 (("al".?_).("al".?_))
307 (("al".?_).("Hj|".?e))
308 (("al".?_).("Cj|".?e))
309 (("al".?.).("al".?w))
310 (("al".?.).("al".?_))
311 (("al".?_).("Hj|".?e))
312 (("al".?_).("Cj|".?e))
313 (("Hj|".?e).("al".?w))
314 (("Cj|".?e).("al".?w))
315 (("Hj|".?e).("al".?_))
316 (("Cj|".?e).("al".?_))
318 "Alist that determines inserting space.")
320 (defun mlh-do-spacing ()
321 "Arrange spacing as you like."
324 (let ((s-tab (syntax-table))
329 (set-syntax-table mlh-syntax-table)
330 (setq s-pc (char-syntax (preceding-char))
331 s-fc (char-syntax (following-char))))
332 (set-syntax-table s-tab))
333 (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
334 c-fc (category-set-mnemonics (char-category-set (following-char))))
335 (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
338 (>= henkan-begin (point))
339 (setq henkan-begin (1+ henkan-begin)))
342 (defvar mlh-select-mode-map (make-keymap))
344 ;;; acutually this map is not necessary now. for future extention
345 (defvar mlh-select-mode-esc-map (make-keymap))
347 (define-key mlh-select-mode-map [t] 'undefined)
348 (define-key mlh-select-mode-esc-map [t] 'undefined)
352 (define-key mlh-select-mode-map (char-to-string ch)
353 'mlh-select-kakutei-and-self-insert)
356 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
357 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
358 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
359 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
360 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
361 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
363 (if (eq window-system 'x)
365 (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
366 (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
369 (defun mlh-select-insert-candidate (n)
370 (delete-region beg (point))
371 (insert (nth n candidates)))
373 (defun mlh-select-prev-candidate ()
375 (setq current-candidate (1- current-candidate))
376 (if (< current-candidate 0)
377 (setq current-candidate (1- number-of-candidates)))
378 (mlh-select-insert-candidate current-candidate))
380 (defun mlh-select-next-candidate ()
382 (setq current-candidate (1+ current-candidate))
383 (if (>= current-candidate number-of-candidates)
384 (setq current-candidate 0))
385 (mlh-select-insert-candidate current-candidate))
387 (defun mlh-recursive-edit-select (beg end candidates)
388 (mlh-select-insert-candidate 0)
389 (and (boundp 'disable-undo) (setq disable-undo t))
390 (let ((old-local-map (current-local-map))
391 (number-of-candidates (length candidates))
392 (current-candidate 0))
393 (use-local-map mlh-select-mode-map)
395 (use-local-map old-local-map)))
397 (defun mlh-select-kakutei-and-self-insert ()
399 (setq unread-command-events (list last-command-event))
400 (mlh-select-kakutei))
402 (defun mlh-select-kakutei ()
404 (and (boundp 'disable-undo) (setq disable-undo nil))
405 (exit-recursive-edit))
407 (defun mlh-user-defined-conversion ()
409 (skip-chars-backward "-a-zA-Z")
410 (mlh-backward-henkan)
412 (goto-char end-marker)
413 (backward-delete-char 2)
414 (let* ((str (buffer-substring beg (point)))
415 (userdef (mlh-userdef<==string str)))
416 (cond ((stringp userdef)
417 (delete-region beg (point))
420 (delete-region beg (point))
421 ;; (add-userdef) (insert new-userdef)
424 (mlh-recursive-edit-select beg (point) userdef))))
425 (if (null henkan-begin)
426 (setq henkan-begin beg)))
428 (defvar mlh-userdef-table nil
429 "Convertion table of words(string) to another words(string).")
431 (defun mlh-userdef<==string (str)
432 "Convert string to another string with `mlh-userdef-table'"
433 (cdr (assoc str mlh-userdef-table)))
435 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
438 (funcall mlh-kanji-function))
440 (defun mlh-kanji-with-henkan-region-function ()
441 (skip-chars-backward "-a-z,.'N[]")
442 (mlh-backward-henkan)
443 (setq inhibit-henkan nil)
445 (goto-char end-marker)
447 (its-translate-region-internal beg (point))
448 (delete-region (point) end-marker)
449 (if (null henkan-begin)
450 (setq henkan-begin beg)))
452 (defun mlh-hiragana ()
454 (skip-chars-backward "-a-z,.'N[]")
455 (mlh-backward-henkan)
457 (goto-char end-marker)
459 (its-translate-region-internal beg (point))
460 (delete-region (point) end-marker)
461 (setq henkan-begin (point)))
463 (defun mlh-hiragana-to-kanji ()
465 (skip-chars-backward "
\e$B$!
\e(B-
\e$B$s!<
\e(B")
466 (mlh-backward-henkan)
468 (setq inhibit-henkan nil)
469 (goto-char end-marker)
470 (backward-delete-char 2)
471 (if (null henkan-begin)
472 (setq henkan-begin beg)))
474 (defun mlh-katakana ()
476 (skip-chars-backward "-a-z,.'N[]")
477 (mlh-backward-henkan)
479 (goto-char end-marker)
481 (its-translate-region-internal beg (point))
482 (insert (mlh-hira-to-kata
484 (buffer-substring beg (point))
485 (delete-region beg (point)))))
486 (delete-region (point) end-marker)
487 (if (null henkan-begin)
488 (setq henkan-begin beg)))
490 (defun mlh-zenkaku ()
492 (skip-chars-backward "\041-\056\060-\176")
493 (mlh-backward-henkan)
495 (goto-char end-marker)
496 (backward-delete-char 2)
497 (japanese-zenkaku-region beg (point))
498 (if (null henkan-begin)
499 (setq henkan-begin beg)))
501 (defun mlh-hira-to-kata (str)
502 "Convert hiragana to katakana in STR."
503 (let ((result (copy-sequence str))
505 (while (setq i (string-match "[
\e$B$!
\e(B-
\e$B$s
\e(B]" str i))
506 (aset result (1+ i) ?\245)
512 (skip-chars-backward "a-zEO-RTW,.[]")
513 (mlh-backward-henkan)
515 (setq inhibit-henkan nil)
516 (goto-char end-marker)
518 (let (its-current-map its-current-language)
519 (its-select-hangul t)
520 (its-translate-region-internal beg (point)))
521 (delete-region (point) end-marker)
522 (if (null henkan-begin)
523 (setq henkan-begin beg)))
525 (defun mlh-zhongwen ()
527 (skip-chars-backward "a-z0-4 ,.[]")
528 (mlh-backward-henkan)
530 (setq inhibit-henkan nil)
531 (goto-char end-marker)
533 (let (its-current-map its-current-language)
534 (its-select-pinyin-cn t)
535 (its-translate-region-internal beg (point)))
536 (delete-region (point) end-marker)
537 (if (null henkan-begin)
538 (setq henkan-begin beg)))
540 (defun mlh-zhongwen-tw ()
542 (skip-chars-backward "a-z0-4,.[]")
543 (mlh-backward-henkan)
545 (setq inhibit-henkan nil)
546 (goto-char end-marker)
548 (let (its-current-map its-current-language)
549 (its-select-pinyin-tw t)
550 (its-translate-region-internal beg (point)))
551 (delete-region (point) end-marker)
552 (if (null henkan-begin)
553 (setq henkan-begin beg)))
556 ;;; egg-mlh.el ends here.