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 will be part of GNU Emacs (in future).
  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 (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."
  40   (interactive)
  41   (let ((henkan-begin nil)
  42         (inhibit-henkan t)
  43         (its-disable-special-action t))
  44     (its-select-hiragana)    ;; force to Japanese
  45     (mlh-backward-henkan)
  46     (if henkan-begin
  47         (if (or inhibit-henkan (= henkan-begin (point)))
  48             (egg-do-auto-fill)
  49           (progn
  50             (message "Converting...")
  51             (sit-for 0)
  52             (egg-convert-region henkan-begin (point))
  53             (message "") ))
  54       (setq this-command 'self-insert-command)
  55       (call-interactively 'self-insert-command))))
  56
  57 (defvar mlh-punctuations nil)
  58 (if mlh-punctuations
  59     ()
  60   (setq mlh-punctuations "!()?;:"))
  61
  62 (defvar mlh-conversion-scheme-table
  63   '(
  64     (?- . mlh-kanji)
  65 ;    (?` . mlh-ltn)
  66 ;    (?' . mlh-ltn)
  67 ;    (?, . mlh-ltn)
  68     (?, . mlh-kanji)
  69     (?. . mlh-kanji)
  70 ;    (?^ . mlh-ltn)
  71 ;    (?~ . mlh-ltn)
  72 ;    (?\". mlh-ltn)
  73 ;    (?@ . mlh-ltn)
  74 ;    (?< . mlh-ltn)
  75 ;    (?> . mlh-ltn)
  76     (?a . mlh-kanji)
  77 ;    (?b . mlh-)
  78     (?c . mlh-capitalize)
  79     (?d . mlh-user-defined-conversion)
  80     (?e . mlh-kanji)
  81     (?f . mlh-hiragana)
  82     (?g . mlh-greek)
  83     (?h . mlh-hangul)
  84     (?i . mlh-kanji)
  85     (?j . mlh-jis-code)
  86     (?k . mlh-katakana)
  87 ;    (?l . mlh-ligature)
  88 ;    (?m . mlh-)
  89     (?n . mlh-kanji)
  90 ;    (?n . mlh-no-conversion)
  91     (?o . mlh-kanji)
  92     (?p . mlh-upcase-letter)
  93     (?q . mlh-quit)
  94 ;    (?r . mlh-)
  95     (?s . mlh-small-letter)
  96     (?t . mlh-zhongwen-tw)
  97     (?u . mlh-kanji)
  98 ;    (?v . mlh-)
  99     (?w . mlh-white-space)
 100     (?x . mlh-execute)
 101 ;    (?y . mlh-)
 102     (?z . mlh-zhongwen)
 103     (?H . mlh-hiragana-to-kanji)
 104     (?L . mlh-lisp-expression)
 105     (?W . mlh-zenkaku-white)
 106     (?X . mlh-exit)
 107     (?Z . mlh-zenkaku)
 108 ))
 109 \f
 110 (defun mlh-zenkaku-white ()
 111   (forward-char -1)
 112   (skip-chars-backward "0-9")
 113   (mlh-backward-henkan)
 114   (setq beg (point))
 115   (goto-char end-marker)
 116   (backward-delete-char 2)
 117   (let* ((str (buffer-substring beg (point)))
 118          (val (string-to-int str)))
 119     (delete-region beg (point))
 120     (if (= val 0)
 121         (setq val 1))
 122     (while (> val 0)
 123       (insert "\e$B!!\e(B")
 124       (setq val (1- val))))
 125   (if (null henkan-begin)
 126       (setq henkan-begin beg)))
 127
 128 (defun mlh-exit ()
 129   (goto-char end-marker)
 130   (backward-delete-char 2)
 131   (insert " ")
 132   (setq henkan-begin (point)))
 133
 134 (defun mlh-upcase-letter ()
 135   (forward-char -1)
 136   (skip-chars-backward "a-zA-Z0-9")
 137   (mlh-backward-henkan)
 138   (setq beg (point))
 139   (goto-char end-marker)
 140   (backward-delete-char 2)
 141   (upcase-region beg (point))
 142   (if (null henkan-begin)
 143       (setq henkan-begin beg)))
 144
 145 (defun mlh-capitalize ()
 146   (forward-char -1)
 147   (skip-chars-backward "a-zA-Z1-9")
 148   (mlh-backward-henkan)
 149   (setq beg (point))
 150   (goto-char end-marker)
 151   (backward-delete-char 2)
 152   (capitalize-region beg (point))
 153   (if (null henkan-begin)
 154       (setq henkan-begin beg)))
 155
 156 (defun mlh-jis-code ()
 157   (forward-char -1)
 158   (skip-chars-backward "0-9a-fA-F")
 159   (mlh-backward-henkan)
 160   (setq beg (point))
 161   (goto-char end-marker)
 162   (backward-delete-char 2)
 163   (let* ((str (buffer-substring beg (point)))
 164          (val (read-jis-code-from-string str)))
 165     ;;         ^--- this function is in egg.el
 166     (delete-region beg (point))
 167     (if val
 168         (insert (make-character lc-jp (car val) (cdr val)))
 169       (insert "?jis?")))
 170   (if (null henkan-begin)
 171       (setq henkan-begin beg)))
 172
 173 (defun mlh-lisp-expression ()
 174   (forward-char -1)
 175   (let ((stab (syntax-table)))
 176     (unwind-protect
 177         (progn
 178           (set-syntax-table emacs-lisp-mode-syntax-table)
 179           (forward-sexp -1))
 180       (set-syntax-table stab)))
 181   (mlh-backward-henkan)
 182   (setq beg (point))
 183   (goto-char end-marker)
 184   (backward-delete-char 2)
 185   (let* ((exp-str
 186           (buffer-substring beg (point)))
 187          (exp (car (read-from-string exp-str)))
 188          (result (eval exp)))
 189     (delete-region beg (point))
 190     (insert (format "%s" result)))
 191   (if (null henkan-begin)
 192       (setq henkan-begin beg)))
 193
 194 (defun mlh-quit ()
 195   (goto-char end-marker)
 196   (backward-delete-char 2)
 197   (setq henkan-begin (point)))
 198
 199 (defun mlh-no-conversion ()
 200   (forward-char -1)
 201   (skip-chars-backward "\041-\056\060-\176")
 202   (mlh-backward-henkan)
 203   (setq beg (point))
 204   (goto-char end-marker)
 205   (backward-delete-char 2)
 206   (if (null henkan-begin)
 207       (setq henkan-begin beg)))
 208
 209 (fset 'mlh-small-letter (symbol-function 'mlh-no-conversion))
 210
 211 (defun mlh-white-space ()
 212   (forward-char -1)
 213   (skip-chars-backward "0-9")
 214   (mlh-backward-henkan)
 215   (setq beg (point))
 216   (goto-char end-marker)
 217   (backward-delete-char 2)
 218   (let* ((str (buffer-substring beg (point)))
 219          (val (string-to-int str)))
 220     (delete-region beg (point))
 221     (if (= val 0)
 222         (setq val 1))
 223     (insert (make-string val ?\ )))
 224   (if (null henkan-begin)
 225       (setq henkan-begin beg)))
 226
 227 (defun mlh-execute ()
 228   (forward-char -1)
 229   (if (fboundp 'mlh-userdef-function)
 230       (mlh-userdef-function)
 231     (mlh-backward-henkan)
 232     (setq beg (point))
 233     (goto-char end-marker)
 234     (backward-delete-char 2)
 235     (if (null henkan-begin)
 236         (setq henkan-begin beg))))
 237 \f
 238 (defun mlh-backward-henkan ()
 239   "For each words seperated by / (slash), do conversion.
 240 Accoding to a character preceding slash, conversion scheme are selected.
 241
 242 CHAR.  MNEMONIC             CONVERSION SCHEME
 243
 244   H    Hiragana to kanji    Convert Hiragana to Kanji
 245   L    Lisp                 Evaluate as Emacs-Lisp expression
 246   W    zenkaku White space  Insert Zenkaku spaces
 247   X    eXit                 Quit going backward, insert space
 248   Z    Zenkaku              Convert to Zenkaku
 249   c    Capitalize           Capitalize
 250   d    user Definition      Convert with user definition table
 251   f    Firagana ??          Convert to Hiragana
 252   g    Greek letter         Convert to single greek letter
 253   h    Hangul               Convert to Hangul
 254   j    Jis-code             Convert to character which has code
 255   k    Katakana             Convert to Katakana
 256   l    Ligature             Ligature (not implemented yet)
 257   p    uPcase letter        uPcase
 258   q    Quit                 Quit going backward
 259   s    Small letter         No conversion
 260   w    White space          Insert spaces
 261   x    eXecute              Call user defined function
 262   z    Zhongwen             Convert to Zhongwen
 263     OTHERWISE               Convert to KANJI
 264 "
 265   (if (eq (preceding-char) ?/)
 266       (let ((end-marker (point-marker))
 267             (char nil)
 268             (beg nil))
 269         (set-marker-insertion-type end-marker t)
 270         (unwind-protect
 271             (let (scheme)
 272               (backward-char 1)
 273               (setq char (preceding-char))
 274               (cond
 275                ((setq scheme (assq char mlh-conversion-scheme-table))
 276                 (funcall (cdr scheme)))
 277                (t
 278                 (goto-char end-marker)))
 279               (if beg
 280                   (progn
 281                     (goto-char beg)
 282                     (mlh-do-spacing)
 283                     (goto-char end-marker))))
 284           (set-marker end-marker nil)))))
 285
 286 \f
 287 (defvar mlh-syntax-table nil
 288   "Syntax table of mlh, which are used to determine spacing.")
 289 (if mlh-syntax-table
 290     ()
 291   (setq mlh-syntax-table (copy-syntax-table emacs-lisp-mode-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)
 297   (modify-syntax-entry ?} "){" mlh-syntax-table)
 298 )
 299
 300 ;;; XXX RTFM, gniibe!
 301 (defvar mlh-space-control
 302   '(
 303     (("al".?w).("al".?w))
 304     (("al".?w).("al".?_))
 305     (("al".?w).("Hj|".?e))
 306     (("al".?w).("Cj|".?e))
 307     (("al".?_).("al".?w))
 308     (("al".?_).("al".?_))
 309     (("al".?_).("Hj|".?e))
 310     (("al".?_).("Cj|".?e))
 311     (("al".?.).("al".?w))
 312     (("al".?.).("al".?_))
 313     (("al".?_).("Hj|".?e))
 314     (("al".?_).("Cj|".?e))
 315     (("Hj|".?e).("al".?w))
 316     (("Cj|".?e).("al".?w))
 317     (("Hj|".?e).("al".?_))
 318     (("Cj|".?e).("al".?_))
 319     )
 320   "Alist that determines inserting space.")
 321
 322 (defun mlh-do-spacing ()
 323   "Arrange spacing as you like."
 324   (if (bobp)
 325       ()
 326     (let ((s-tab (syntax-table))
 327           s-pc s-fc
 328           c-pc c-fc)
 329       (unwind-protect
 330           (progn
 331             (set-syntax-table mlh-syntax-table)
 332             (setq s-pc (char-syntax (preceding-char))
 333                   s-fc (char-syntax (following-char))))
 334         (set-syntax-table s-tab))
 335       (setq c-pc (category-set-mnemonics (char-category-set (preceding-char)))
 336             c-fc (category-set-mnemonics (char-category-set (following-char))))
 337       (if (member (cons (cons c-pc s-pc) (cons c-fc s-fc)) mlh-space-control)
 338           (progn
 339             (and henkan-begin
 340                  (>= henkan-begin (point))
 341                  (setq henkan-begin (1+ henkan-begin)))
 342             (insert " "))))))
 343 \f
 344 (defvar mlh-select-mode-map (make-keymap))
 345
 346 ;;; acutually this map is not necessary now. for future extention
 347 (defvar mlh-select-mode-esc-map (make-keymap))
 348
 349 (define-key mlh-select-mode-map [t] 'undefined)
 350 (define-key mlh-select-mode-esc-map [t] 'undefined)
 351
 352 (let ((ch 32))
 353   (while (< ch 127)
 354     (define-key mlh-select-mode-map (char-to-string ch)
 355       'mlh-select-kakutei-and-self-insert)
 356     (setq ch (1+ ch))))
 357
 358 (define-key mlh-select-mode-map "\C-m" 'mlh-select-kakutei-and-self-insert)
 359 (define-key mlh-select-mode-map "\C-b" 'mlh-select-prev-candidate)
 360 (define-key mlh-select-mode-map "\C-f" 'mlh-select-next-candidate)
 361 (define-key mlh-select-mode-map "\177" 'mlh-select-prev-candidate)
 362 (define-key mlh-select-mode-map " " 'mlh-select-next-candidate)
 363 (define-key mlh-select-mode-map "/" 'mlh-select-kakutei)
 364
 365 (if (eq window-system 'x)
 366     (let ()
 367       (define-key mlh-select-mode-map [return] 'mlh-select-kakutei-and-self-insert)
 368       (define-key mlh-select-mode-map [delete] 'mlh-select-prev-candidate)
 369       ))
 370
 371 (defun mlh-select-insert-candidate (n)
 372   (delete-region beg (point))
 373   (insert (nth n candidates)))
 374
 375 (defun mlh-select-prev-candidate ()
 376   (interactive)
 377   (setq current-candidate (1- current-candidate))
 378   (if (< current-candidate 0)
 379       (setq current-candidate (1- number-of-candidates)))
 380   (mlh-select-insert-candidate current-candidate))
 381
 382 (defun mlh-select-next-candidate ()
 383   (interactive)
 384   (setq current-candidate (1+ current-candidate))
 385   (if (>= current-candidate number-of-candidates)
 386       (setq current-candidate 0))
 387   (mlh-select-insert-candidate current-candidate))
 388
 389 (defun mlh-recursive-edit-select (beg end candidates)
 390   (mlh-select-insert-candidate 0)
 391   (and (boundp 'disable-undo) (setq disable-undo t))
 392   (let ((old-local-map (current-local-map))
 393         (number-of-candidates (length candidates))
 394         (current-candidate 0))
 395     (use-local-map mlh-select-mode-map)
 396     (recursive-edit)
 397     (use-local-map old-local-map)))
 398
 399 (defun mlh-select-kakutei-and-self-insert ()
 400   (interactive)
 401   (setq unread-command-events (list last-command-event))
 402   (mlh-select-kakutei))
 403
 404 (defun mlh-select-kakutei ()
 405   (interactive)
 406   (and (boundp 'disable-undo) (setq disable-undo nil))
 407   (exit-recursive-edit))
 408 \f
 409 (defun mlh-user-defined-conversion ()
 410   (forward-char -1)
 411   (skip-chars-backward "-a-zA-Z")
 412   (mlh-backward-henkan)
 413   (setq beg (point))
 414   (goto-char end-marker)
 415   (backward-delete-char 2)
 416   (let* ((str (buffer-substring beg (point)))
 417          (userdef (mlh-userdef<==string str)))
 418     (cond ((stringp userdef)
 419            (delete-region beg (point))
 420            (insert userdef))
 421           ((null userdef)
 422            (delete-region beg (point))
 423            ;; (add-userdef) (insert new-userdef)
 424            (insert "?udef?"))
 425           ((consp userdef)
 426            (mlh-recursive-edit-select beg (point) userdef))))
 427   (if (null henkan-begin)
 428       (setq henkan-begin beg)))
 429
 430 (defvar mlh-userdef-table nil
 431   "Convertion table of words(string) to another words(string).")
 432
 433 (defun mlh-userdef<==string (str)
 434   "Convert string to another string with `mlh-userdef-table'"
 435   (cdr (assoc str mlh-userdef-table)))
 436 \f
 437 (defvar mlh-kanji-function 'mlh-kanji-with-henkan-region-function)
 438
 439 (defun mlh-kanji ()
 440   (funcall mlh-kanji-function))
 441
 442 (defun mlh-kanji-with-henkan-region-function ()
 443   (skip-chars-backward "-a-z,.'N[]")
 444   (mlh-backward-henkan)
 445   (setq inhibit-henkan nil)
 446   (setq beg (point))
 447   (goto-char end-marker)
 448   (forward-char -1)
 449   (its-translate-region-internal beg (point))
 450   (delete-region (point) end-marker)
 451   (if (null henkan-begin)
 452       (setq henkan-begin beg)))
 453
 454 (defun mlh-hiragana ()
 455   (forward-char -1)
 456   (skip-chars-backward "-a-z,.'N[]")
 457   (mlh-backward-henkan)
 458   (setq beg (point))
 459   (goto-char end-marker)
 460   (forward-char -2)
 461   (its-translate-region-internal beg (point))
 462   (delete-region (point) end-marker)
 463   (setq henkan-begin (point)))
 464
 465 (defun mlh-hiragana-to-kanji ()
 466   (forward-char -1)
 467   (skip-chars-backward "\e$B$!\e(B-\e$B$s!<\e(B")
 468   (mlh-backward-henkan)
 469   (setq beg (point))
 470   (setq inhibit-henkan nil)
 471   (goto-char end-marker)
 472   (backward-delete-char 2)
 473   (if (null henkan-begin)
 474       (setq henkan-begin beg)))
 475
 476 (defun mlh-katakana ()
 477   (forward-char -1)
 478   (skip-chars-backward "-a-z,.'N[]")
 479   (mlh-backward-henkan)
 480   (setq beg (point))
 481   (goto-char end-marker)
 482   (forward-char -2)
 483   (its-translate-region-internal beg (point))
 484   (insert (mlh-hira-to-kata
 485            (prog1
 486                (buffer-substring beg (point))
 487              (delete-region beg (point)))))
 488   (delete-region (point) end-marker)
 489   (if (null henkan-begin)
 490       (setq henkan-begin beg)))
 491
 492 (defun mlh-zenkaku ()
 493   (forward-char -1)
 494   (skip-chars-backward "\041-\056\060-\176")
 495   (mlh-backward-henkan)
 496   (setq beg (point))
 497   (goto-char end-marker)
 498   (backward-delete-char 2)
 499   (japanese-zenkaku-region beg (point))
 500   (if (null henkan-begin)
 501       (setq henkan-begin beg)))
 502
 503 (defun mlh-hira-to-kata (str)
 504   "Convert hiragana to katakana in STR."
 505   (let ((result (copy-sequence str))
 506         (i 0))
 507     (while (setq i (string-match "[\e$B$!\e(B-\e$B$s\e(B]" str i))
 508       (aset result (1+ i) ?\245)
 509       (setq i (+ i 3)))
 510     result))
 511
 512 (defun mlh-hangul ()
 513   (forward-char -1)
 514   (skip-chars-backward "a-zEO-RTW,.[]")
 515   (mlh-backward-henkan)
 516   (setq beg (point))
 517   (setq inhibit-henkan nil)
 518   (goto-char end-marker)
 519   (forward-char -2)
 520   (let (its-current-map its-current-language)
 521     (its-select-hangul t)
 522     (its-translate-region-internal beg (point)))
 523   (delete-region (point) end-marker)
 524   (if (null henkan-begin)
 525       (setq henkan-begin beg)))
 526
 527 (defun mlh-zhongwen ()
 528   (forward-char -1)
 529   (skip-chars-backward "a-z0-4 ,.[]")
 530   (mlh-backward-henkan)
 531   (setq beg (point))
 532   (setq inhibit-henkan nil)
 533   (goto-char end-marker)
 534   (forward-char -2)
 535   (let (its-current-map its-current-language)
 536     (its-select-pinyin-cn t)
 537     (its-translate-region-internal beg (point)))
 538   (delete-region (point) end-marker)
 539   (if (null henkan-begin)
 540       (setq henkan-begin beg)))
 541
 542 (defun mlh-zhongwen-tw ()
 543   (forward-char -1)
 544   (skip-chars-backward "a-z0-4,.[]")
 545   (mlh-backward-henkan)
 546   (setq beg (point))
 547   (setq inhibit-henkan nil)
 548   (goto-char end-marker)
 549   (forward-char -2)
 550   (let (its-current-map its-current-language)
 551     (its-select-pinyin-tw t)
 552     (its-translate-region-internal beg (point)))
 553   (delete-region (point) end-marker)
 554   (if (null henkan-begin)
 555       (setq henkan-begin beg)))
 556
 557 (provide 'egg-mlh)
 558 ;;; egg-mlh.el ends here.