egg-mlh.el

   1 ;;; egg-mlh.el --- Modeless Conversion Facility in Egg Input
   2 ;;;                   Method Architecture
   3
   4 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
   5
   6 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   7 ;;         KATAYAMA Yoshio <kate@pfu.co.jp>      ; Multilingual Enhancement
   8
   9 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
  10
  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
  32
  33 ;;; Code:
  34
  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 (assq '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   (if (/= (- end-marker (point)) 6)
 168       (error "invalid length"))
 169   (setq beg (point))
 170   (let ((val (car (read-from-string
 171                    (concat "?\\x" (buffer-substring beg (- end-marker 2)))))))
 172     (insert (make-char 'japanese-jisx0208 (/ val 256) (% val 256)))
 173     (delete-region (point) end-marker))
 174   (if (null henkan-begin)
 175       (setq henkan-begin beg)))
 176
 177 (defun mlh-lisp-expression ()
 178   (forward-char -1)
 179   (let ((stab (syntax-table)))
 180     (unwind-protect
 181         (progn
 182           (set-syntax-table emacs-lisp-mode-syntax-table)
 183           (forward-sexp -1))
 184       (set-syntax-table stab)))
 185   (mlh-backward-henkan)
 186   (setq beg (point))
 187   (goto-char end-marker)
 188   (backward-delete-char 2)
 189   (let* ((exp-str
 190           (buffer-substring beg (point)))
 191          (exp (car (read-from-string exp-str)))
 192          (result (eval exp)))
 193     (delete-region beg (point))
 194     (insert (format "%s" result)))
 195   (if (null henkan-begin)
 196       (setq henkan-begin beg)))
 197
 198 (defun mlh-quit ()
 199   (goto-char end-marker)
 200   (backward-delete-char 2)
 201   (setq henkan-begin (point)))
 202
 203 (defun mlh-no-conversion ()
 204   (forward-char -1)
 205   (skip-chars-backward "\041-\056\060-\176")
 206   (mlh-backward-henkan)
 207   (setq beg (point))
 208   (goto-char end-marker)
 209   (backward-delete-char 2)
 210   (if (null henkan-begin)
 211       (setq henkan-begin beg)))
 212
 213 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
 214
 215 (defun mlh-white-space ()
 216   (forward-char -1)
 217   (skip-chars-backward "0-9")
 218   (mlh-backward-henkan)
 219   (setq beg (point))
 220   (goto-char end-marker)
 221   (backward-delete-char 2)
 222   (let* ((str (buffer-substring beg (point)))
 223          (val (string-to-int str)))
 224     (delete-region beg (point))
 225     (if (= val 0)
 226         (setq val 1))
 227     (insert (make-string val ?\ )))
 228   (if (null henkan-begin)
 229       (setq henkan-begin beg)))
 230
 231 (defun mlh-execute ()
 232   (forward-char -1)
 233   (if (fboundp 'mlh-userdef-function)
 234       (mlh-userdef-function)
 235     (mlh-backward-henkan)
 236     (setq beg (point))
 237     (goto-char end-marker)
 238     (backward-delete-char 2)
 239     (if (null henkan-begin)
 240         (setq henkan-begin beg))))
 241 \f
 242 (defun mlh-backward-henkan ()
 243   "For each words seperated by / (slash), do conversion.
 244 Accoding to a character preceding slash, conversion scheme are selected.
 245
 246 CHAR.  MNEMONIC             CONVERSION SCHEME
 247
 248   H    Hiragana to kanji    Convert Hiragana to Kanji
 249   L    Lisp                 Evaluate as Emacs-Lisp expression
 250   W    zenkaku White space  Insert Zenkaku spaces
 251   X    eXit                 Quit going backward, insert space
 252   Z    Zenkaku              Convert to Zenkaku
 253   c    Capitalize           Capitalize
 254   d    user Definition      Convert with user definition table
 255   f    Firagana ??          Convert to Hiragana
 256   g    Greek letter         Convert to single greek letter
 257   h    Hangul               Convert to Hangul
 258   j    Jis-code             Convert to character which has code
 259   k    Katakana             Convert to Katakana
 260   l    Ligature             Ligature (not implemented yet)
 261   p    uPcase letter        uPcase
 262   q    Quit                 Quit going backward
 263   s    Small letter         No conversion
 264   w    White space          Insert spaces
 265   x    eXecute              Call user defined function
 266   z    Zhongwen             Convert to Zhongwen
 267     OTHERWISE               Convert to KANJI
 268 "
 269   (if (eq (preceding-char) ?/)
 270       (let ((end-marker (point-marker))
 271             (char nil)
 272             (beg nil))
 273         (set-marker-insertion-type end-marker t)
 274         (unwind-protect
 275             (let (scheme)
 276               (backward-char 1)
 277               (setq char (preceding-char))
 278               (cond
 279                ((setq scheme (assq char mlh-conversion-scheme-table))
 280                 (funcall (cdr scheme)))
 281                (t
 282                 (goto-char end-marker)))
 283               (if beg
 284                   (progn
 285                     (goto-char beg)
 286                     (mlh-do-spacing)
 287                     (goto-char end-marker))))
 288           (set-marker end-marker nil)))))
 289
 290 \f
 291 (defvar mlh-syntax-table nil
 292   "Syntax table of mlh, which are used to determine spacing.")
 293 (if mlh-syntax-table
 294     ()
 295   (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
 296   (modify-syntax-entry ?! "." mlh-syntax-table)
 297   (modify-syntax-entry ?$ "'" mlh-syntax-table)
 298   (modify-syntax-entry ?% "'" mlh-syntax-table)
 299   (modify-syntax-entry ?& "'" mlh-syntax-table)
 300   (modify-syntax-entry ?{ "(}" mlh-syntax-table)
 301   (modify-syntax-entry ?} "){" mlh-syntax-table)
 302 )
 303
 304 ;;; XXX RTFM, gniibe!
 305 (defvar mlh-space-control
 306   '(
 307     (("al".?w).("al".?w))
 308     (("al".?w).("al".?_))
 309     (("al".?w).("Hj|".?e))
 310     (("al".?w).("Cj|".?e))
 311     (("al".?_).("al".?w))
 312     (("al".?_).("al".?_))
 313     (("al".?_).("Hj|".?e))
 314     (("al".?_).("Cj|".?e))
 315     (("al".?.).("al".?w))
 316     (("al".?.).("al".?_))
 317     (("al".?_).("Hj|".?e))
 318     (("al".?_).("Cj|".?e))
 319     (("Hj|".?e).("al".?w))
 320     (("Cj|".?e).("al".?w))
 321     (("Hj|".?e).("al".?_))
 322     (("Cj|".?e).("al".?_))
 323     )
 324   "Alist that determines inserting space.")
 325
 326 (defun mlh-do-spacing ()
 327   "Arrange spacing as you like."
 328   (if (bobp)
 329       ()
 330     (let ((s-tab (syntax-table))
 331           s-pc s-fc
 332           c-pc c-fc)
 333       (unwind-protect
 334           (progn
 335             (set-syntax-table mlh-syntax-table)
 336             (setq s-pc (char-syntax (preceding-char))
 337                   s-fc (char-syntax (following-char))))
 338         (set-syntax-table s-tab))
 339       (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
 340             c-fc (category-set-mnemonics (char-category-set (following-char))))
 341       (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
 342           (progn
 343             (and henkan-begin
 344                  (>= henkan-begin (point))
 345                  (setq henkan-begin (1+ henkan-begin)))
 346             (insert " "))))))
 347 \f
 348 (defvar mlh-select-mode-map (make-keymap))
 349
 350 ;;; acutually this map is not necessary now. for future extention
 351 (defvar mlh-select-mode-esc-map (make-keymap))
 352
 353 (define-key mlh-select-mode-map [t] 'undefined)
 354 (define-key mlh-select-mode-esc-map [t] 'undefined)
 355
 356 (let ((ch 32))
 357   (while (< ch 127)
 358     (define-key mlh-select-mode-map (char-to-string ch)
 359       'mlh-select-kakutei-and-self-insert)
 360     (setq ch (1+ ch))))
 361
 362 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
 363 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
 364 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
 365 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
 366 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
 367 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
 368
 369 (if (eq window-system 'x)
 370     (let ()
 371       (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
 372       (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
 373       ))
 374
 375 (defun mlh-select-insert-candidate (n)
 376   (delete-region beg (point))
 377   (insert (nth n candidates)))
 378
 379 (defun mlh-select-prev-candidate ()
 380   (interactive)
 381   (setq current-candidate (1- current-candidate))
 382   (if (< current-candidate 0)
 383       (setq current-candidate (1- number-of-candidates)))
 384   (mlh-select-insert-candidate current-candidate))
 385
 386 (defun mlh-select-next-candidate ()
 387   (interactive)
 388   (setq current-candidate (1+ current-candidate))
 389   (if (>= current-candidate number-of-candidates)
 390       (setq current-candidate 0))
 391   (mlh-select-insert-candidate current-candidate))
 392
 393 (defun mlh-recursive-edit-select (beg end candidates)
 394   (mlh-select-insert-candidate 0)
 395   (and (boundp 'disable-undo) (setq disable-undo t))
 396   (let ((old-local-map (current-local-map))
 397         (number-of-candidates (length candidates))
 398         (current-candidate 0))
 399     (use-local-map mlh-select-mode-map)
 400     (recursive-edit)
 401     (use-local-map old-local-map)))
 402
 403 (defun mlh-select-kakutei-and-self-insert ()
 404   (interactive)
 405   (setq unread-command-events (list last-command-event))
 406   (mlh-select-kakutei))
 407
 408 (defun mlh-select-kakutei ()
 409   (interactive)
 410   (and (boundp 'disable-undo) (setq disable-undo nil))
 411   (exit-recursive-edit))
 412 \f
 413 (defun mlh-user-defined-conversion ()
 414   (forward-char -1)
 415   (skip-chars-backward "-a-zA-Z")
 416   (mlh-backward-henkan)
 417   (setq beg (point))
 418   (goto-char end-marker)
 419   (backward-delete-char 2)
 420   (let* ((str (buffer-substring beg (point)))
 421          (userdef (mlh-userdef<==string str)))
 422     (cond ((stringp userdef)
 423            (delete-region beg (point))
 424            (insert userdef))
 425           ((null userdef)
 426            (delete-region beg (point))
 427            ;; (add-userdef) (insert new-userdef)
 428            (insert "?udef?"))
 429           ((consp userdef)
 430            (mlh-recursive-edit-select beg (point) userdef))))
 431   (if (null henkan-begin)
 432       (setq henkan-begin beg)))
 433
 434 (defvar mlh-userdef-table nil
 435   "Convertion table of words(string) to another words(string).")
 436
 437 (defun mlh-userdef<==string (str)
 438   "Convert string to another string with `mlh-userdef-table'"
 439   (cdr (assoc str mlh-userdef-table)))
 440 \f
 441 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
 442
 443 (defun mlh-kanji ()
 444   (funcall mlh-kanji-function))
 445
 446 (defun mlh-kanji-with-henkan-region-function ()
 447   (skip-chars-backward "-a-z,.'N[]")
 448   (mlh-backward-henkan)
 449   (setq inhibit-henkan nil)
 450   (setq beg (point))
 451   (goto-char end-marker)
 452   (forward-char -1)
 453   (its-translate-region-internal beg (point))
 454   (delete-region (point) end-marker)
 455   (if (null henkan-begin)
 456       (setq henkan-begin beg)))
 457
 458 (defun mlh-hiragana ()
 459   (forward-char -1)
 460   (skip-chars-backward "-a-z,.'N[]")
 461   (mlh-backward-henkan)
 462   (setq beg (point))
 463   (goto-char end-marker)
 464   (forward-char -2)
 465   (its-translate-region-internal beg (point))
 466   (delete-region (point) end-marker)
 467   (setq henkan-begin (point)))
 468
 469 (defun mlh-hiragana-to-kanji ()
 470   (forward-char -1)
 471   (skip-chars-backward "\e$B$!\e(B-\e$B$s!<\e(B")
 472   (mlh-backward-henkan)
 473   (setq beg (point))
 474   (setq inhibit-henkan nil)
 475   (goto-char end-marker)
 476   (backward-delete-char 2)
 477   (if (null henkan-begin)
 478       (setq henkan-begin beg)))
 479
 480 (defun mlh-katakana ()
 481   (forward-char -1)
 482   (skip-chars-backward "-a-z,.'N[]")
 483   (mlh-backward-henkan)
 484   (setq beg (point))
 485   (goto-char end-marker)
 486   (forward-char -2)
 487   (its-translate-region-internal beg (point))
 488   (japanese-katakana-region beg (point))
 489   (delete-region (point) end-marker)
 490   (if (null henkan-begin)
 491       (setq henkan-begin beg)))
 492
 493 (defun mlh-zenkaku ()
 494   (forward-char -1)
 495   (skip-chars-backward "\041-\056\060-\176")
 496   (mlh-backward-henkan)
 497   (setq beg (point))
 498   (goto-char end-marker)
 499   (backward-delete-char 2)
 500   (japanese-zenkaku-region beg (point))
 501   (if (null henkan-begin)
 502       (setq henkan-begin beg)))
 503
 504 (defun mlh-hangul ()
 505   (forward-char -1)
 506   (skip-chars-backward "a-zEO-RTW,.[]")
 507   (mlh-backward-henkan)
 508   (setq beg (point))
 509   (setq inhibit-henkan nil)
 510   (goto-char end-marker)
 511   (forward-char -2)
 512   (let (its-current-map its-current-language)
 513     (its-select-hangul nil t)
 514     (its-translate-region-internal beg (point)))
 515   (delete-region (point) end-marker)
 516   (if (null henkan-begin)
 517       (setq henkan-begin beg)))
 518
 519 (defun mlh-zhongwen ()
 520   (forward-char -1)
 521   (skip-chars-backward "a-z0-4 ,.[]")
 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-pinyin-cn nil 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-tw ()
 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-tw nil 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 (provide 'egg-mlh)
 550 ;;; egg-mlh.el ends here.