egg-mlh.el

   1 ;;; egg-mlh.el --- Modeless Conversion Facility in Egg Input
   2 ;;;                   Method Architecture
   3
   4 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
   5 ;; Laboratory, JAPAN.
   6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   7
   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
  12
  13 ;; This file is part of EGG.
  14
  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)
  18 ;; any later version.
  19
  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.
  24
  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.
  29
  30 ;;; Commentary:
  31 ;; Once written by NIIBE Yutaka in mlh-1.002 distribution.
  32 ;; Then, assigned to Mule Project.
  33
  34 ;;; Code:
  35
  36 (defvar mlh-default-backend "wnn")
  37
  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."
  42   (interactive)
  43   (let ((henkan-begin nil)
  44         (inhibit-henkan t)
  45         (its-disable-special-action t))
  46     (if (null (assoc "Japanese" egg-conversion-backend-alist))
  47         (progn
  48           (setq egg-mode-preference nil)
  49           (activate-input-method (concat "japanese-egg-" mlh-default-backend)))
  50       ;; force to Japanese
  51       (its-select-hiragana))
  52     (mlh-backward-henkan)
  53     (if henkan-begin
  54         (if (or inhibit-henkan (= henkan-begin (point)))
  55             (egg-do-auto-fill)
  56           (progn
  57             (message "Converting...")
  58             (sit-for 0)
  59             (egg-convert-region henkan-begin (point))
  60             (message "") ))
  61       (setq this-command 'self-insert-command)
  62       (call-interactively 'self-insert-command))))
  63
  64 (defvar mlh-punctuations nil)
  65 (if mlh-punctuations
  66     ()
  67   (setq mlh-punctuations "!()?;:"))
  68
  69 (defvar mlh-conversion-scheme-table
  70   '(
  71     (?- . mlh-kanji)
  72 ;    (?` . mlh-ltn)
  73 ;    (?' . mlh-ltn)
  74 ;    (?, . mlh-ltn)
  75     (?, . mlh-kanji)
  76     (?. . mlh-kanji)
  77 ;    (?^ . mlh-ltn)
  78 ;    (?~ . mlh-ltn)
  79 ;    (?\". mlh-ltn)
  80 ;    (?@ . mlh-ltn)
  81 ;    (?< . mlh-ltn)
  82 ;    (?> . mlh-ltn)
  83     (?a . mlh-kanji)
  84 ;    (?b . mlh-)
  85     (?c . mlh-capitalize)
  86     (?d . mlh-user-defined-conversion)
  87     (?e . mlh-kanji)
  88     (?f . mlh-hiragana)
  89     (?g . mlh-greek)
  90     (?h . mlh-hangul)
  91     (?i . mlh-kanji)
  92     (?j . mlh-jis-code)
  93     (?k . mlh-katakana)
  94 ;    (?l . mlh-ligature)
  95 ;    (?m . mlh-)
  96     (?n . mlh-kanji)
  97 ;    (?n . mlh-no-conversion)
  98     (?o . mlh-kanji)
  99     (?p . mlh-upcase-letter)
 100     (?q . mlh-quit)
 101 ;    (?r . mlh-)
 102     (?s . mlh-small-letter)
 103     (?t . mlh-zhongwen-tw)
 104     (?u . mlh-kanji)
 105 ;    (?v . mlh-)
 106     (?w . mlh-white-space)
 107     (?x . mlh-execute)
 108 ;    (?y . mlh-)
 109     (?z . mlh-zhongwen)
 110     (?H . mlh-hiragana-to-kanji)
 111     (?L . mlh-lisp-expression)
 112     (?W . mlh-zenkaku-white)
 113     (?X . mlh-exit)
 114     (?Z . mlh-zenkaku)
 115 ))
 116 \f
 117 (defun mlh-zenkaku-white ()
 118   (forward-char -1)
 119   (skip-chars-backward "0-9")
 120   (mlh-backward-henkan)
 121   (setq beg (point))
 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))
 127     (if (= val 0)
 128         (setq val 1))
 129     (while (> val 0)
 130       (insert "\e$B!!\e(B")
 131       (setq val (1- val))))
 132   (if (null henkan-begin)
 133       (setq henkan-begin beg)))
 134
 135 (defun mlh-exit ()
 136   (goto-char end-marker)
 137   (backward-delete-char 2)
 138   (insert " ")
 139   (setq henkan-begin (point)))
 140
 141 (defun mlh-upcase-letter ()
 142   (forward-char -1)
 143   (skip-chars-backward "a-zA-Z0-9")
 144   (mlh-backward-henkan)
 145   (setq beg (point))
 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)))
 151
 152 (defun mlh-capitalize ()
 153   (forward-char -1)
 154   (skip-chars-backward "a-zA-Z1-9")
 155   (mlh-backward-henkan)
 156   (setq beg (point))
 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)))
 162
 163 (defun mlh-jis-code ()
 164   (forward-char -1)
 165   (skip-chars-backward "0-9a-fA-F")
 166   (mlh-backward-henkan)
 167   (setq beg (point))
 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))
 174     (if val
 175         (insert (make-character lc-jp (car val) (cdr val)))
 176       (insert "?jis?")))
 177   (if (null henkan-begin)
 178       (setq henkan-begin beg)))
 179
 180 (defun mlh-lisp-expression ()
 181   (forward-char -1)
 182   (let ((stab (syntax-table)))
 183     (unwind-protect
 184         (progn
 185           (set-syntax-table emacs-lisp-mode-syntax-table)
 186           (forward-sexp -1))
 187       (set-syntax-table stab)))
 188   (mlh-backward-henkan)
 189   (setq beg (point))
 190   (goto-char end-marker)
 191   (backward-delete-char 2)
 192   (let* ((exp-str
 193           (buffer-substring beg (point)))
 194          (exp (car (read-from-string exp-str)))
 195          (result (eval exp)))
 196     (delete-region beg (point))
 197     (insert (format "%s" result)))
 198   (if (null henkan-begin)
 199       (setq henkan-begin beg)))
 200
 201 (defun mlh-quit ()
 202   (goto-char end-marker)
 203   (backward-delete-char 2)
 204   (setq henkan-begin (point)))
 205
 206 (defun mlh-no-conversion ()
 207   (forward-char -1)
 208   (skip-chars-backward "\041-\056\060-\176")
 209   (mlh-backward-henkan)
 210   (setq beg (point))
 211   (goto-char end-marker)
 212   (backward-delete-char 2)
 213   (if (null henkan-begin)
 214       (setq henkan-begin beg)))
 215
 216 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
 217
 218 (defun mlh-white-space ()
 219   (forward-char -1)
 220   (skip-chars-backward "0-9")
 221   (mlh-backward-henkan)
 222   (setq beg (point))
 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))
 228     (if (= val 0)
 229         (setq val 1))
 230     (insert (make-string val ?\ )))
 231   (if (null henkan-begin)
 232       (setq henkan-begin beg)))
 233
 234 (defun mlh-execute ()
 235   (forward-char -1)
 236   (if (fboundp 'mlh-userdef-function)
 237       (mlh-userdef-function)
 238     (mlh-backward-henkan)
 239     (setq beg (point))
 240     (goto-char end-marker)
 241     (backward-delete-char 2)
 242     (if (null henkan-begin)
 243         (setq henkan-begin beg))))
 244 \f
 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.
 248
 249 CHAR.  MNEMONIC             CONVERSION SCHEME
 250
 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
 271 "
 272   (if (eq (preceding-char) ?/)
 273       (let ((end-marker (point-marker))
 274             (char nil)
 275             (beg nil))
 276         (set-marker-insertion-type end-marker t)
 277         (unwind-protect
 278             (let (scheme)
 279               (backward-char 1)
 280               (setq char (preceding-char))
 281               (cond
 282                ((setq scheme (assq char mlh-conversion-scheme-table))
 283                 (funcall (cdr scheme)))
 284                (t
 285                 (goto-char end-marker)))
 286               (if beg
 287                   (progn
 288                     (goto-char beg)
 289                     (mlh-do-spacing)
 290                     (goto-char end-marker))))
 291           (set-marker end-marker nil)))))
 292
 293 \f
 294 (defvar mlh-syntax-table nil
 295   "Syntax table of mlh, which are used to determine spacing.")
 296 (if mlh-syntax-table
 297     ()
 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)
 305 )
 306
 307 ;;; XXX RTFM, gniibe!
 308 (defvar mlh-space-control
 309   '(
 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".?_))
 326     )
 327   "Alist that determines inserting space.")
 328
 329 (defun mlh-do-spacing ()
 330   "Arrange spacing as you like."
 331   (if (bobp)
 332       ()
 333     (let ((s-tab (syntax-table))
 334           s-pc s-fc
 335           c-pc c-fc)
 336       (unwind-protect
 337           (progn
 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)
 345           (progn
 346             (and henkan-begin
 347                  (>= henkan-begin (point))
 348                  (setq henkan-begin (1+ henkan-begin)))
 349             (insert " "))))))
 350 \f
 351 (defvar mlh-select-mode-map (make-keymap))
 352
 353 ;;; acutually this map is not necessary now. for future extention
 354 (defvar mlh-select-mode-esc-map (make-keymap))
 355
 356 (define-key mlh-select-mode-map [t] 'undefined)
 357 (define-key mlh-select-mode-esc-map [t] 'undefined)
 358
 359 (let ((ch 32))
 360   (while (< ch 127)
 361     (define-key mlh-select-mode-map (char-to-string ch)
 362       'mlh-select-kakutei-and-self-insert)
 363     (setq ch (1+ ch))))
 364
 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)
 371
 372 (if (eq window-system 'x)
 373     (let ()
 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)
 376       ))
 377
 378 (defun mlh-select-insert-candidate (n)
 379   (delete-region beg (point))
 380   (insert (nth n candidates)))
 381
 382 (defun mlh-select-prev-candidate ()
 383   (interactive)
 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))
 388
 389 (defun mlh-select-next-candidate ()
 390   (interactive)
 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))
 395
 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)
 403     (recursive-edit)
 404     (use-local-map old-local-map)))
 405
 406 (defun mlh-select-kakutei-and-self-insert ()
 407   (interactive)
 408   (setq unread-command-events (list last-command-event))
 409   (mlh-select-kakutei))
 410
 411 (defun mlh-select-kakutei ()
 412   (interactive)
 413   (and (boundp 'disable-undo) (setq disable-undo nil))
 414   (exit-recursive-edit))
 415 \f
 416 (defun mlh-user-defined-conversion ()
 417   (forward-char -1)
 418   (skip-chars-backward "-a-zA-Z")
 419   (mlh-backward-henkan)
 420   (setq beg (point))
 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))
 427            (insert userdef))
 428           ((null userdef)
 429            (delete-region beg (point))
 430            ;; (add-userdef) (insert new-userdef)
 431            (insert "?udef?"))
 432           ((consp userdef)
 433            (mlh-recursive-edit-select beg (point) userdef))))
 434   (if (null henkan-begin)
 435       (setq henkan-begin beg)))
 436
 437 (defvar mlh-userdef-table nil
 438   "Convertion table of words(string) to another words(string).")
 439
 440 (defun mlh-userdef<==string (str)
 441   "Convert string to another string with `mlh-userdef-table'"
 442   (cdr (assoc str mlh-userdef-table)))
 443 \f
 444 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
 445
 446 (defun mlh-kanji ()
 447   (funcall mlh-kanji-function))
 448
 449 (defun mlh-kanji-with-henkan-region-function ()
 450   (skip-chars-backward "-a-z,.'N[]")
 451   (mlh-backward-henkan)
 452   (setq inhibit-henkan nil)
 453   (setq beg (point))
 454   (goto-char end-marker)
 455   (forward-char -1)
 456   (its-translate-region-internal beg (point))
 457   (delete-region (point) end-marker)
 458   (if (null henkan-begin)
 459       (setq henkan-begin beg)))
 460
 461 (defun mlh-hiragana ()
 462   (forward-char -1)
 463   (skip-chars-backward "-a-z,.'N[]")
 464   (mlh-backward-henkan)
 465   (setq beg (point))
 466   (goto-char end-marker)
 467   (forward-char -2)
 468   (its-translate-region-internal beg (point))
 469   (delete-region (point) end-marker)
 470   (setq henkan-begin (point)))
 471
 472 (defun mlh-hiragana-to-kanji ()
 473   (forward-char -1)
 474   (skip-chars-backward "\e$B$!\e(B-\e$B$s!<\e(B")
 475   (mlh-backward-henkan)
 476   (setq beg (point))
 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)))
 482
 483 (defun mlh-katakana ()
 484   (forward-char -1)
 485   (skip-chars-backward "-a-z,.'N[]")
 486   (mlh-backward-henkan)
 487   (setq beg (point))
 488   (goto-char end-marker)
 489   (forward-char -2)
 490   (its-translate-region-internal beg (point))
 491   (insert (mlh-hira-to-kata
 492            (prog1
 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)))
 498
 499 (defun mlh-zenkaku ()
 500   (forward-char -1)
 501   (skip-chars-backward "\041-\056\060-\176")
 502   (mlh-backward-henkan)
 503   (setq beg (point))
 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)))
 509
 510 (defun mlh-hira-to-kata (str)
 511   "Convert hiragana to katakana in STR."
 512   (let ((result (copy-sequence str))
 513         (i 0))
 514     (while (setq i (string-match "[\e$B$!\e(B-\e$B$s\e(B]" str i))
 515       (aset result (1+ i) ?\245)
 516       (setq i (+ i 3)))
 517     result))
 518
 519 (defun mlh-hangul ()
 520   (forward-char -1)
 521   (skip-chars-backward "a-zEO-RTW,.[]")
 522   (mlh-backward-henkan)
 523   (setq beg (point))
 524   (setq inhibit-henkan nil)
 525   (goto-char end-marker)
 526   (forward-char -2)
 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)))
 533
 534 (defun mlh-zhongwen ()
 535   (forward-char -1)
 536   (skip-chars-backward "a-z0-4 ,.[]")
 537   (mlh-backward-henkan)
 538   (setq beg (point))
 539   (setq inhibit-henkan nil)
 540   (goto-char end-marker)
 541   (forward-char -2)
 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)))
 548
 549 (defun mlh-zhongwen-tw ()
 550   (forward-char -1)
 551   (skip-chars-backward "a-z0-4,.[]")
 552   (mlh-backward-henkan)
 553   (setq beg (point))
 554   (setq inhibit-henkan nil)
 555   (goto-char end-marker)
 556   (forward-char -2)
 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)))
 563
 564 (provide 'egg-mlh)
 565 ;;; egg-mlh.el ends here.