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