egg-mlh.el

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