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