egg-sim-old.el

   1 ;;; egg-sim.el --- EGG Simple Input Method
   2
   3 ;; Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5 ;; Copyright (C) 2000 TOMURA Satoru <tomura@etl.go.jp>
   6
   7
   8 ;; Author: TOMURA Satoru <tomura@etl.go.jp>
   9
  10 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
  11
  12 ;; Keywords: mule, multilingual, input method
  13
  14 ;; This file is part of EGG.
  15
  16 ;; EGG is free software; you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation; either version 2, or (at your option)
  19 ;; any later version.
  20
  21 ;; EGG is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 ;; Boston, MA 02111-1307, USA.
  30
  31 ;;; Commentary:
  32
  33 ;;; Code:
  34
  35 ;;; This code is based on egg-jsymbol.el of Egg V3.
  36
  37 ;;; 92.10.18 modified for Mule Ver.0.9.6 by K.Handa <handa@etl.go.jp>
  38 ;;;     Moved from egg.el
  39 ;;; 92.12.26 modified for Mule Ver.0.9.7 by T.Shingu <shingu@cpr.canon.co.jp>
  40 ;;;     JIS Hojo Kanji support.
  41
  42 (require 'menudiag)
  43
  44 (provide 'egg-sim)
  45
  46 (defun make-char-list (charset &optional from to)
  47   (let ((result nil)
  48         (chars (charset-chars charset))
  49         min max)
  50     (setq min (if (= chars 96) 32 33)
  51           max (if (= chars 96) 127 126))
  52     (setq from (if from (+ min (1- from)) min)
  53           to   (if to (+ min (1- to)) max))
  54     (and (<= min from)
  55          (<= to max)
  56          (cond ((= (charset-dimension charset) 1)
  57                 (while (<= from to)
  58                   (setq result (cons (char-to-string
  59                                       (make-char charset to))
  60                                      result)
  61                         to (1- to)))
  62                 result)
  63                ((= (charset-dimension charset) 2)
  64                 (while (<= from to)
  65                   (let ((code max))
  66                     (while (<= min code)
  67                       (setq result (cons (char-to-string
  68                                           (make-char charset to code))
  69                                          result)
  70                             code (1- code))))
  71                   (setq to (1- to)))
  72                 result)))))
  73
  74 (defvar egg-sim-ascii-menu
  75   '(menu "ASCII:" ,(make-char-list 'ascii)))
  76
  77 (defvar egg-sim-latin-1-menu
  78   `(menu "ISO 8859-1:" ,(make-char-list 'latin-iso8859-1)))
  79
  80 (defvar egg-sim-latin-2-menu
  81   `(menu "ISO 8859-2:" ,(make-char-list 'latin-iso8859-2)))
  82
  83 (defvar egg-sim-latin-3-menu
  84   `(menu "ISO 8859-3:" ,(make-char-list 'latin-iso8859-3)))
  85
  86 (defvar egg-sim-latin-4-menu
  87   `(menu "ISO 8859-4:" ,(make-char-list 'latin-iso8859-4)))
  88
  89 (defvar egg-sim-latin-5-menu
  90   `(menu "ISO 8859-9:" ,(make-char-list 'latin-iso8859-9)))
  91
  92 (defvar egg-sim-cyrillic-menu
  93   `(menu "ISO 8859-5:" ,(make-char-list 'cyrillic-iso8859-5)))
  94
  95 (defvar egg-sim-arabic-menu
  96   `(menu "ISO 8859-6:" ,(make-char-list 'arabic-iso8859-6)))
  97
  98 (defvar egg-sim-greek-menu
  99   `(menu "ISO 8859-7:" ,(make-char-list 'greek-iso8859-7)))
 100
 101 (defvar egg-sim-hebrew-menu
 102   `(menu "ISO 8859-8:" ,(make-char-list 'hebrew-iso8859-8)))
 103
 104 (defvar egg-sim-thai-menu
 105   `(menu "TIS620.2529:" ,(make-char-list 'thai-tis620)))
 106
 107 (defvar egg-sim-lao-menu
 108   `(menu "lao:"         ,(make-char-list 'lao)))
 109
 110 (defvar egg-sim-vietnamese-menu
 111   `(menu "Vietnamese:"
 112          (("VISCII1.1(lower-case)" .
 113            (menu "VISCII1.1 lower-case:"
 114                  ,(make-char-list 'vietnamese-viscii-lower)))
 115           ("VISCII1.1(upper-case)" .
 116            (menu "VISCII1.1 upper-case:"
 117                  ,(make-char-list 'vietnamese-viscii-upper))))))
 118
 119 (defvar egg-sim-chinese-big5-menu
 120   `(menu "Big5:"
 121          (("Level1" .
 122            (menu "Big 5 Level1:" , (make-char-list 'chinese-big5-1)))
 123           ("Level2" .
 124            (menu "Big 5 Level2:" , (make-char-list 'chinese-big5-2))))))
 125
 126 (defvar egg-sim-chinese-cns-menu
 127   `(menu "CNS 11643:"
 128          (("Plane-1" .
 129            (menu "CNS 11643-1:" ,(make-char-list 'chinese-cns11643-1)))
 130           ("Plane- 2" .
 131            (menu "CNS 11643-2:" ,(make-char-list 'chinese-cns11643-2)))
 132           ("Plane-3" .
 133            (menu "CNS 11643-3:" ,(make-char-list 'chinese-cns11643-3)))
 134           ("Plane-4" .
 135            (menu "CNS 11643-4:" ,(make-char-list 'chinese-cns11643-4)))
 136           ("Plane-5" .
 137            (menu "CNS 11643-5:" ,(make-char-list 'chinese-cns11643-5)))
 138           ("Plane-6" .
 139            (menu "CNS 11643-6:" ,(make-char-list 'chinese-cns11643-6)))
 140           ("Plane-7" .
 141            (menu "CNS 11643-7:" ,(make-char-list 'chinese-cns11643-7))))))
 142
 143 (defvar egg-sim-chinese-gb-menu
 144   `(menu "GB 2312:"
 145          (("All" .
 146            (menu "GB 2312:" ,(make-char-list 'chinese-gb2312)))
 147           ("Symbols" .
 148            (menu "GB2312/1:" ,(make-char-list 'chinese-gb2312 1 1)))
 149           ("Numbers" .
 150            (menu "GB2312/2:" ,(make-char-list 'chinese-gb2312 2 2)))
 151           ("Fullwidth ASCII" .
 152            (menu "GB2312/3:" ,(make-char-list 'chinese-gb2312 3 3)))
 153           ("Hiragana" .
 154            (menu "GB2312/4:" ,(make-char-list 'chinese-gb2312 4 4)))
 155           ("Katanaka" .
 156            (menu "GB2312/5:" ,(make-char-list 'chinese-gb2312 5 5)))
 157           ("Greek" .
 158            (menu "GB2312/6:" ,(make-char-list 'chinese-gb2312 6 6)))
 159           ("Cyrillic" .
 160            (menu "GB2312/7:" ,(make-char-list 'chinese-gb2312 7 7)))
 161           ("Pinyin/Bopomofo" .
 162            (menu "GB2312/8:" ,(make-char-list 'chinese-gb2312 8 8)))
 163           ("Box Drawings" .
 164            (menu "GB2312/9:" ,(make-char-list 'chinese-gb2312 9 9)))
 165           )))
 166
 167 (defvar egg-sim-chinese-menu
 168   `(menu "Chinese:"
 169          (("GB2312"  . , egg-sim-chinese-gb-menu)
 170           ("CNS11643" . , egg-sim-chinese-cns-menu)
 171           ("Big5" . , egg-sim-chinese-big5-menu))))
 172
 173 (defvar egg-sim-korean-menu
 174   `(menu "Korean:"
 175          (("KSC5601"  .
 176            (menu "KSC 5601:" ,(make-char-list 'korean-ksc5601)))
 177           ("Symbol" .
 178            (menu "KSC 5601/1-2:" ,(make-char-list 'korean-ksc5601 1 2)))
 179           ("Fullwidth ASCII" .
 180            (menu "KSC 5601/3:" , (make-char-list 'korean-ksc5601 3 3)))
 181           ("Jamo" .
 182            (menu "KSC 5601/4:" , (make-char-list 'korean-ksc5601 4 4)))
 183           ("Roman Number/Greek" .
 184            (menu "KSC 5601/5:" , (make-char-list 'korean-ksc5601 5 5)))
 185           ("Box Drawings" .
 186            (menu "KSC 5601/6:" , (make-char-list 'korean-ksc5601 6 6)))
 187           ("Unit" .
 188            (menu "KSC 5601/7:" , (make-char-list 'korean-ksc5601 7 7)))
 189           ("Misc." .
 190            (menu "KSC 5601/8-9:" , (make-char-list 'korean-ksc5601 8 9)))
 191           ("Hiragana" .
 192            (menu "KSC 5601/10:" , (make-char-list 'korean-ksc5601 10 10)))
 193           ("Katakana" .
 194            (menu "KSC 5601/11:" , (make-char-list 'korean-ksc5601 11 11)))
 195           ("Cyrillic" .
 196            (menu "KSC 5601/12:" , (make-char-list 'korean-ksc5601 12 12)))
 197           ("Hangul" .
 198            (menu "KSC 5601/16-40:" , (make-char-list 'korean-ksc5601 16 40)))
 199           ("Hanja" .
 200            (menu "KSC 5601/42-93:" , (make-char-list 'korean-ksc5601 42 93))))))
 201
 202 (defvar egg-sim-japanese-menu
 203   `(menu "Japanese:"
 204          (("JISX0201" .
 205            ,(append (make-char-list 'latin-jisx0201)
 206                     (make-char-list 'katakana-jisx0201)))
 207           ("JISX0208" .
 208            (menu "JIS X 0208:" ,(make-char-list 'japanese-jisx0208)))
 209           ("JISX0212" .
 210            (menu "JIS X 0212:" ,(make-char-list 'japanese-jisx0212)))
 211           ("JISX0208/0212" .
 212            (menu "\e$B5-9fF~NO\e(B:"
 213                  (("JIS\e$BF~NO\e(B" . japanese-jisx0208)
 214                   ("\e$B5-9f\e(B"     .
 215                    (menu "\e$B5-9f\e(B:"     , (make-char-list 'japanese-jisx0208 1 2)))
 216                   ("\e$B1Q?t;z\e(B"   .
 217                    (menu "\e$B1Q?t;z\e(B:"   , (make-char-list 'japanese-jisx0208 3 3)))
 218                   ("\e$B$R$i$,$J\e(B" .
 219                    (menu "\e$B$R$i$,$J\e(B:" , (make-char-list 'japanese-jisx0208 4 4)))
 220                   ("\e$B%+%?%+%J\e(B" .
 221                    (menu "\e$B%+%?%+%J\e(B:" , (make-char-list 'japanese-jisx0208 5 5)))
 222                   ("\e$B%.%j%7%cJ8;z\e(B" .
 223                    (menu "\e$B%.%j%7%cJ8;z\e(B:" , (make-char-list 'japanese-jisx0208 6 6)))
 224                   ("\e$B%-%j%kJ8;z\e(B" .
 225                    (menu "\e$B%-%j%kJ8;z\e(B:" , (make-char-list 'japanese-jisx0208 7 7)))
 226                   ("\e$B7S@~\e(B" .
 227                    (menu "\e$B7S@~\e(B:" , (make-char-list 'japanese-jisx0208 8 8)))
 228                           ;;;"\e$BIt<sF~NO\e(B"  (bushyu-input)
 229                           ;;; "\e$B2h?tF~NO\e(B" (kakusuu-input)
 230                   ("\e$BBh0l?e=`\e(B" .
 231                    (menu "\e$BBh0l?e=`\e(B:" , (make-char-list 'japanese-jisx0208 16 47)))
 232                   ("\e$BBhFs?e=`\e(B" .
 233                    (menu "\e$BBhFs?e=`\e(B:" , (make-char-list 'japanese-jisx0208 48 84)))
 234                   ("\e$BJd=u4A;z\e(B" .
 235                    (menu "\e$BJd=u4A;z\e(B:" , (make-char-list 'japanese-jisx0212 2 77)))))))))
 236
 237 (defvar egg-sim-ipa-menu
 238   `(menu "IPA:" ,(make-char-list 'ipa)))
 239
 240 (defvar egg-sisheng-menu
 241   `(menu "SiSheng characters" ,(make-char-list 'chinese-sisheng)))
 242
 243 (defvar egg-sim-code-input-menu
 244   `(menu "Charset:"
 245          (("JISX0208" . japanese-jisx0208)
 246           ("JISX0212" . japanese-jisx0212)
 247           ("CNS11643-1" . chinese-cns11634-1)
 248           ("CNS11643-2" . chinese-cns11634-2)
 249           ("CNS11643-3" . chinese-cns11634-3)
 250           ("CNS11643-4" . chinese-cns11634-4)
 251           ("CNS11643-5" . chinese-cns11634-5)
 252           ("CNS11643-6" . chinese-cns11634-6)
 253           ("CNS11643-7" . chinese-cns11634-7)
 254           ("Big5-1" . chinese-big5-1)
 255           ("Big5-2" . chinese-big5-2)
 256           ("GB2312" . chinese-gb2312)
 257           ("KSC5601" . korean-ksc5601))))
 258
 259 (defvar egg-simple-input-method-menu-item-list
 260   `(("Code Input" . ,egg-sim-code-input-menu)
 261     ("Arabic"   . , egg-sim-arabic-menu)
 262     ("ASCII"    . , egg-sim-ascii-menu)
 263     ("Chinese"  . , egg-sim-chinese-menu)
 264     ("Cyrillic" . , egg-sim-cyrillic-menu)
 265     ("Greek"    . , egg-sim-greek-menu)
 266     ("Hebrew"   . , egg-sim-hebrew-menu)
 267     ("Japanese" . , egg-sim-japanese-menu)
 268     ("Korean"   . , egg-sim-korean-menu)
 269     ("Latin" .
 270      (menu "Latin:"
 271            (("Latin-1" . , egg-sim-latin-1-menu)
 272             ("Latin-2" . , egg-sim-latin-2-menu)
 273             ("Latin-3" . , egg-sim-latin-3-menu)
 274             ("Latin-4" . , egg-sim-latin-4-menu)
 275             ("Latin-5" . , egg-sim-latin-5-menu))))
 276     ("Thai/Lao" .
 277      (menu "Thai/Lao:"
 278            (("Thai" . , egg-sim-thai-menu)
 279             ("Lao"  . , egg-sim-lao-menu))))
 280     ("Vietnamese" . , egg-sim-vietnamese-menu)
 281     ("Phonetic code" .
 282      (menu "Phonetic code:"
 283            (("SISHENG" . , egg-sisheng-menu)
 284             ("IPA" .  , egg-sim-ipa-menu))))
 285     ))
 286
 287 (defvar egg-language-environment-alist
 288   `(("ASCII"         . , egg-sim-ascii-menu)
 289     ("Chinese-BIG5"  . , egg-sim-chinese-big5-menu)
 290     ("Chinese-CNS"   . , egg-sim-chinese-cns-menu)
 291     ("Chinese-GB"    . , egg-sim-chinese-gb-menu)
 292     ("Cyrillic-ISO"  . , egg-sim-cyrillic-menu)
 293     ("Cyrillic-KOI8" . , egg-sim-cyrillic-menu)
 294     ("Cyrillic-ALT"  . , egg-sim-cyrillic-menu)
 295     ("Czech"         . , egg-sim-latin-2-menu)
 296     ("Devanagari")
 297     ("English"       . , egg-sim-ascii-menu)
 298     ("Ethiopic")
 299     ("German"        . , egg-sim-latin-1-menu)
 300     ("Greek"         . , egg-sim-greek-menu)
 301     ("Hebrew"        . , egg-sim-hebrew-menu)
 302     ("Hindi")
 303     ("IPA"           . , egg-sim-ipa-menu)
 304     ("Japanese"      . , egg-sim-japanese-menu)
 305     ("Korean"        . , egg-sim-korean-menu)
 306     ("Lao"           . , egg-sim-lao-menu)
 307     ("Latin-1"       . , egg-sim-latin-1-menu)
 308     ("Latin-2"       . , egg-sim-latin-2-menu)
 309     ("Latin-3"       . , egg-sim-latin-3-menu)
 310     ("Latin-4"       . , egg-sim-latin-4-menu)
 311     ("Latin-5"       . , egg-sim-latin-5-menu)
 312     ("Romaian"       . , egg-sim-latin-2-menu)
 313     ("Slovenian"     . , egg-sim-latin-2-menu)
 314     ("Slovak"        . , egg-sim-latin-2-menu)
 315     ("Thai"          . , egg-sim-thai-menu)
 316     ("Tibetan")
 317     ("Turkish"       . , egg-sim-latin-5-menu)
 318     ("Vietnamese"    . , egg-sim-vietnamese-menu)))
 319
 320 (defvar egg-simple-input-method-menu
 321   `(menu "Character set:" , egg-simple-input-method-menu-item-list))
 322
 323 ;;;;###autoload
 324 (defun egg-simple-input-method()
 325   (interactive)
 326   (let ((result (egg-simple-input-menu)))
 327     (cond((stringp result)
 328           (insert result))
 329          ((symbolp result)
 330           (egg-character-code-input result
 331                                     (format "%s/Character Code in Hexadecimal:"
 332                                             (charset-description result)))))))
 333
 334 (defun egg-simple-input-menu ()
 335   (let ((menu (cdr-safe (assoc current-language-environment
 336                                egg-language-environment-alist))))
 337     (if menu
 338         (menudiag-select
 339          `(menu "Character set:" ,(cons (cons current-language-environment
 340                                               menu)
 341                                         egg-simple-input-method-menu-item-list)))
 342       (menudiag-select egg-simple-input-method-menu))))
 343
 344 (defun egg-character-code-input (charset prompt)
 345   (egg-insert-character-code-from-minibuffer charset prompt))
 346
 347 (defun egg-insert-character-code-from-minibuffer (charset prompt)
 348   (let ((str (read-from-minibuffer prompt)) val)
 349     (while (null (setq val (egg-read-character-code-from-string str charset)))
 350       (beep)
 351       (setq str (read-from-minibuffer prompt str)))
 352     (insert (make-char charset (car val) (cdr val)))))
 353
 354 (defun egg-hexadigit-value (ch)
 355   (cond((and (<= ?0 ch) (<= ch ?9))
 356         (- ch ?0))
 357        ((and (<= ?a ch) (<= ch ?f))
 358         (+ (- ch ?a) 10))
 359        ((and (<= ?A ch) (<= ch ?F))
 360         (+ (- ch ?A) 10))))
 361
 362 (defun egg-read-character-code-from-string (str charset)
 363   (if (and (= (length str) 4)
 364            (<= 2 (egg-hexadigit-value (aref str 0)))
 365            (egg-hexadigit-value (aref str 1))
 366            (<= 2 (egg-hexadigit-value (aref str 2)))
 367            (egg-hexadigit-value (aref str 3)))
 368       (let ((code1 (+ (* 16 (egg-hexadigit-value (aref str 0)))
 369                       (egg-hexadigit-value (aref str 1))))
 370             (code2 (+ (* 16 (egg-hexadigit-value (aref str 2)))
 371                       (egg-hexadigit-value (aref str 3))))
 372             (min (if (= (charset-chars charset) 94)
 373                      33 32))
 374             (max (if (= (charset-chars charset) 94)
 375                      126 127)))
 376         (and (<= min code1)
 377              (<= code1 max)
 378              (<= min code2)
 379              (<= code2 max)
 380              (cons code1 code2)))))
 381
 382 ;;;
 383 ;;;
 384 ;;;
 385
 386 (defun make-non-iso2022-code-table-file (name)
 387   (with-temp-file name
 388     (set-buffer-multibyte nil)
 389     (insert ";;; -*- coding: -*-\n\n")
 390     (insert " |")
 391
 392     (let ((i 0))
 393       (while (< i 16)
 394         (insert (format "  %X " i))
 395         (setq i (1+ i))))
 396     (insert "\n")
 397
 398     (insert "-+")
 399     (let ((i 0))
 400       (while (< i 16)
 401         (insert (format "----" i))
 402         (setq i (1+ i))))
 403     (insert "\n")
 404
 405     (let ((i 0))
 406       (while (< i 16)
 407         (insert (format "%X|" i))
 408         (let ((j 0) (c i))
 409           (while (< j 16)
 410             (insert (format " \"%c\"" c))
 411             (setq j (1+ j)
 412                   c (+ c 16)))
 413           (insert (format "\n")))
 414         (setq i (1+ i))))))
 415
 416 (defun make-iso2022-94char-code-table-file (name)
 417   (with-temp-file name
 418     (set-buffer-multibyte nil)
 419     (insert ";;; -*- coding: -*-\n\n")
 420     (insert " |")
 421     (let ((i 0))
 422       (while (< i 16)
 423         (insert (format "  %X " i))
 424         (setq i (1+ i))))
 425     (insert "\n")
 426
 427     (insert "-+")
 428     (let ((i 0))
 429       (while (< i 16)
 430         (insert (format "----" i))
 431         (setq i (1+ i))))
 432     (insert "\n")
 433
 434     (let ((i 0))
 435       (while (< i 16)
 436         (insert (format "%X|" i))
 437         (let ((j 0) (c i))
 438           (while (< j 16)
 439             (if (or (<= c 31)
 440                     (= c 127)
 441                     (and (<= 128 c)
 442                          (<= c 160))
 443                     (= c 255))
 444                 (insert "    ")
 445               (insert (format " \"%c\"" c)))
 446             (setq j (1+ j)
 447                   c (+ c 16)))
 448           (insert (format "\n")))
 449         (setq i (1+ i))))))
 450
 451 (defun make-iso2022-96char-code-table-file (name)
 452   (with-temp-file name
 453     (set-buffer-multibyte nil)
 454     (insert ";;; -*- coding: -*-\n\n")
 455     (insert " |")
 456     (let ((i 0))
 457       (while (< i 16)
 458         (insert (format "  %X " i))
 459         (setq i (1+ i))))
 460     (insert "\n")
 461
 462     (insert "-+")
 463     (let ((i 0))
 464       (while (< i 16)
 465         (insert (format "----" i))
 466         (setq i (1+ i))))
 467     (insert "\n")
 468
 469     (let ((i 0))
 470       (while (< i 16)
 471         (insert (format "%X|" i))
 472         (let ((j 0) (c i))
 473           (while (< j 16)
 474             (if (or (<= c 31)
 475                     (= c 127)
 476                     (and (<= 128 c)
 477                          (< c 160)))
 478                 (insert "    ")
 479               (insert (format " \"%c\"" c)))
 480             (setq j (1+ j)
 481                   c (+ c 16)))
 482           (insert (format "\n")))
 483         (setq i (1+ i))))))
 484
 485 (defun make-euc-code-table-file (name)
 486   (with-temp-file name
 487     (set-buffer-multibyte nil)
 488     (insert ";;; -*- coding: -*-\n\n")
 489     (insert "  |")
 490     (let ((i 1))
 491       (while (<= i 94)
 492         ;;                "XX"
 493         (insert (format "  %02d " i))
 494         (setq i (1+ i))))
 495     (insert "\n")
 496
 497     (insert "-+")
 498     (let ((i 1))
 499       (while (<= i 94)
 500         (insert (format "-----" i))
 501         (setq i (1+ i))))
 502     (insert "\n")
 503
 504     (let ((i 1))
 505       (while (<= i 94)
 506         (insert (format "%02d|" i))
 507         (let ((j 1))
 508           (while (<= j 94)
 509             (insert (format " \"%c%c\""
 510                             (+ i 32 128)
 511                             (+ j 32 128)))
 512             (setq j (1+ j)))
 513           (insert (format "\n")))
 514         (setq i (1+ i))))))