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