1 ;;; egg-mlh.el --- Modeless Conversion Facility in Egg Input
2 ;;; Method Architecture
4 ;; Copyright (C) 1997 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 ;; GNU Emacs 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 ;; GNU Emacs 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)
44 (if (or inhibit-henkan (= henkan-begin (point)))
47 (message "Converting...")
49 (egg-convert-region henkan-begin (point))
51 (setq this-command 'self-insert-command)
52 (call-interactively 'self-insert-command))))
54 (defvar mlh-punctuations nil)
57 (setq mlh-punctuations "!()?;:"))
59 (defvar mlh-conversion-scheme-table
76 (?d . mlh-user-defined-conversion)
87 ; (?n . mlh-no-conversion)
89 (?p . mlh-upcase-letter)
92 (?s . mlh-small-letter)
96 (?w . mlh-white-space)
100 (?H . mlh-hiragana-to-kanji)
101 (?L . mlh-lisp-expression)
102 (?W . mlh-zenkaku-white)
107 (defun mlh-zenkaku-white ()
109 (skip-chars-backward "0-9")
110 (mlh-backward-henkan)
112 (goto-char end-marker)
113 (backward-delete-char 2)
114 (let* ((str (buffer-substring beg (point)))
115 (val (string-to-int str)))
116 (delete-region beg (point))
120 (insert "
\e$B!!
\e(B")
121 (setq val (1- val))))
122 (if (null henkan-begin)
123 (setq henkan-begin beg)))
126 (goto-char end-marker)
127 (backward-delete-char 2)
129 (setq henkan-begin (point)))
131 (defun mlh-upcase-letter ()
133 (skip-chars-backward "a-zA-Z0-9")
134 (mlh-backward-henkan)
136 (goto-char end-marker)
137 (backward-delete-char 2)
138 (upcase-region beg (point))
139 (if (null henkan-begin)
140 (setq henkan-begin beg)))
142 (defun mlh-capitalize ()
144 (skip-chars-backward "a-zA-Z1-9")
145 (mlh-backward-henkan)
147 (goto-char end-marker)
148 (backward-delete-char 2)
149 (capitalize-region beg (point))
150 (if (null henkan-begin)
151 (setq henkan-begin beg)))
153 (defun mlh-jis-code ()
155 (skip-chars-backward "0-9a-fA-F")
156 (mlh-backward-henkan)
158 (goto-char end-marker)
159 (backward-delete-char 2)
160 (let* ((str (buffer-substring beg (point)))
161 (val (read-jis-code-from-string str)))
162 ;; ^--- this function is in egg.el
163 (delete-region beg (point))
165 (insert (make-character lc-jp (car val) (cdr val)))
167 (if (null henkan-begin)
168 (setq henkan-begin beg)))
170 (defun mlh-lisp-expression ()
172 (let ((stab (syntax-table)))
175 (set-syntax-table emacs-lisp-mode-syntax-table)
177 (set-syntax-table stab)))
178 (mlh-backward-henkan)
180 (goto-char end-marker)
181 (backward-delete-char 2)
183 (buffer-substring beg (point)))
184 (exp (car (read-from-string exp-str)))
186 (delete-region beg (point))
187 (insert (format "%s" result)))
188 (if (null henkan-begin)
189 (setq henkan-begin beg)))
192 (goto-char end-marker)
193 (backward-delete-char 2)
194 (setq henkan-begin (point)))
196 (defun mlh-no-conversion ()
198 (skip-chars-backward "\041-\056\060-\176")
199 (mlh-backward-henkan)
201 (goto-char end-marker)
202 (backward-delete-char 2)
203 (if (null henkan-begin)
204 (setq henkan-begin beg)))
206 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
208 (defun mlh-white-space ()
210 (skip-chars-backward "0-9")
211 (mlh-backward-henkan)
213 (goto-char end-marker)
214 (backward-delete-char 2)
215 (let* ((str (buffer-substring beg (point)))
216 (val (string-to-int str)))
217 (delete-region beg (point))
220 (insert (make-string val ?\ )))
221 (if (null henkan-begin)
222 (setq henkan-begin beg)))
224 (defun mlh-execute ()
226 (if (fboundp 'mlh-userdef-function)
227 (mlh-userdef-function)
228 (mlh-backward-henkan)
230 (goto-char end-marker)
231 (backward-delete-char 2)
232 (if (null henkan-begin)
233 (setq henkan-begin beg))))
235 (defun mlh-backward-henkan ()
236 "For each words seperated by / (slash), do conversion.
237 Accoding to a character preceding slash, conversion scheme are selected.
239 CHAR. MNEMONIC CONVERSION SCHEME
241 H Hiragana to kanji Convert Hiragana to Kanji
242 L Lisp Evaluate as Emacs-Lisp expression
243 W zenkaku White space Insert Zenkaku spaces
244 X eXit Quit going backward, insert space
245 Z Zenkaku Convert to Zenkaku
246 c Capitalize Capitalize
247 d user Definition Convert with user definition table
248 f Firagana ?? Convert to Hiragana
249 g Greek letter Convert to single greek letter
250 h Hangul Convert to Hangul
251 j Jis-code Convert to character which has code
252 k Katakana Convert to Katakana
253 l Ligature Ligature (not implemented yet)
254 p uPcase letter uPcase
255 q Quit Quit going backward
256 s Small letter No conversion
257 w White space Insert spaces
258 x eXecute Call user defined function
259 z Zhongwen Convert to Zhongwen
260 OTHERWISE Convert to KANJI
262 (if (eq (preceding-char) ?/)
263 (let ((end-marker (point-marker))
266 (set-marker-insertion-type end-marker t)
270 (setq char (preceding-char))
272 ((setq scheme (assq char mlh-conversion-scheme-table))
273 (funcall (cdr scheme)))
275 (goto-char end-marker)))
280 (goto-char end-marker))))
281 (set-marker end-marker nil)))))
284 (defvar mlh-syntax-table nil
285 "Syntax table of mlh, which are used to determine spacing.")
288 (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
289 (modify-syntax-entry ?! "." mlh-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)
297 ;;; XXX RTFM, gniibe!
298 (defvar mlh-space-control
300 (("al".?w).("al".?w))
301 (("al".?w).("al".?_))
302 (("al".?w).("Hj|".?e))
303 (("al".?w).("Cj|".?e))
304 (("al".?_).("al".?w))
305 (("al".?_).("al".?_))
306 (("al".?_).("Hj|".?e))
307 (("al".?_).("Cj|".?e))
308 (("al".?.).("al".?w))
309 (("al".?.).("al".?_))
310 (("al".?_).("Hj|".?e))
311 (("al".?_).("Cj|".?e))
312 (("Hj|".?e).("al".?w))
313 (("Cj|".?e).("al".?w))
314 (("Hj|".?e).("al".?_))
315 (("Cj|".?e).("al".?_))
317 "Alist that determines inserting space.")
319 (defun mlh-do-spacing ()
320 "Arrange spacing as you like."
323 (let ((s-tab (syntax-table))
328 (set-syntax-table mlh-syntax-table)
329 (setq s-pc (char-syntax (preceding-char))
330 s-fc (char-syntax (following-char))))
331 (set-syntax-table s-tab))
332 (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
333 c-fc (category-set-mnemonics (char-category-set (following-char))))
334 (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
337 (>= henkan-begin (point))
338 (setq henkan-begin (1+ henkan-begin)))
341 (defvar mlh-select-mode-map (make-keymap))
343 ;;; acutually this map is not necessary now. for future extention
344 (defvar mlh-select-mode-esc-map (make-keymap))
346 (define-key mlh-select-mode-map [t] 'undefined)
347 (define-key mlh-select-mode-esc-map [t] 'undefined)
351 (define-key mlh-select-mode-map (char-to-string ch)
352 'mlh-select-kakutei-and-self-insert)
355 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
356 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
357 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
358 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
359 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
360 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
362 (if (eq window-system 'x)
364 (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
365 (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
368 (defun mlh-select-insert-candidate (n)
369 (delete-region beg (point))
370 (insert (nth n candidates)))
372 (defun mlh-select-prev-candidate ()
374 (setq current-candidate (1- current-candidate))
375 (if (< current-candidate 0)
376 (setq current-candidate (1- number-of-candidates)))
377 (mlh-select-insert-candidate current-candidate))
379 (defun mlh-select-next-candidate ()
381 (setq current-candidate (1+ current-candidate))
382 (if (>= current-candidate number-of-candidates)
383 (setq current-candidate 0))
384 (mlh-select-insert-candidate current-candidate))
386 (defun mlh-recursive-edit-select (beg end candidates)
387 (mlh-select-insert-candidate 0)
388 (and (boundp 'disable-undo) (setq disable-undo t))
389 (let ((old-local-map (current-local-map))
390 (number-of-candidates (length candidates))
391 (current-candidate 0))
392 (use-local-map mlh-select-mode-map)
394 (use-local-map old-local-map)))
396 (defun mlh-select-kakutei-and-self-insert ()
398 (setq unread-command-events (list last-command-event))
399 (mlh-select-kakutei))
401 (defun mlh-select-kakutei ()
403 (and (boundp 'disable-undo) (setq disable-undo nil))
404 (exit-recursive-edit))
406 (defun mlh-user-defined-conversion ()
408 (skip-chars-backward "-a-zA-Z")
409 (mlh-backward-henkan)
411 (goto-char end-marker)
412 (backward-delete-char 2)
413 (let* ((str (buffer-substring beg (point)))
414 (userdef (mlh-userdef<==string str)))
415 (cond ((stringp userdef)
416 (delete-region beg (point))
419 (delete-region beg (point))
420 ;; (add-userdef) (insert new-userdef)
423 (mlh-recursive-edit-select beg (point) userdef))))
424 (if (null henkan-begin)
425 (setq henkan-begin beg)))
427 (defvar mlh-userdef-table nil
428 "Convertion table of words(string) to another words(string).")
430 (defun mlh-userdef<==string (str)
431 "Convert string to another string with `mlh-userdef-table'"
432 (cdr (assoc str mlh-userdef-table)))
434 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
437 (funcall mlh-kanji-function))
439 (defun mlh-kanji-with-henkan-region-function ()
440 (skip-chars-backward "-a-z,.'N[]")
441 (mlh-backward-henkan)
442 (setq inhibit-henkan nil)
444 (goto-char end-marker)
446 (its-translate-region beg (point))
447 (delete-region (point) end-marker)
448 (if (null henkan-begin)
449 (setq henkan-begin beg)))
451 (defun mlh-hiragana ()
453 (skip-chars-backward "-a-z,.'N[]")
454 (mlh-backward-henkan)
456 (goto-char end-marker)
458 (its-translate-region beg (point))
459 (delete-region (point) end-marker)
460 (setq henkan-begin (point)))
462 (defun mlh-hiragana-to-kanji ()
464 (skip-chars-backward "
\e$B$!
\e(B-
\e$B$s!<
\e(B")
465 (mlh-backward-henkan)
467 (setq inhibit-henkan nil)
468 (goto-char end-marker)
469 (backward-delete-char 2)
470 (if (null henkan-begin)
471 (setq henkan-begin beg)))
473 (defun mlh-katakana ()
475 (skip-chars-backward "-a-z,.'N[]")
476 (mlh-backward-henkan)
478 (goto-char end-marker)
480 (its-translate-region beg (point))
481 (insert (mlh-hira-to-kata
483 (buffer-substring beg (point))
484 (delete-region beg (point)))))
485 (delete-region (point) end-marker)
486 (if (null henkan-begin)
487 (setq henkan-begin beg)))
489 (defun mlh-zenkaku ()
491 (skip-chars-backward "\041-\056\060-\176")
492 (mlh-backward-henkan)
494 (goto-char end-marker)
495 (backward-delete-char 2)
496 (japanese-zenkaku-region beg (point))
497 (if (null henkan-begin)
498 (setq henkan-begin beg)))
500 (defun mlh-hira-to-kata (str)
501 "Convert hiragana to katakana in STR."
502 (let ((result (copy-sequence str))
504 (while (setq i (string-match "[
\e$B$!
\e(B-
\e$B$s
\e(B]" str i))
505 (aset result (1+ i) ?\245)
510 ;;; egg-mlh.el ends here.