egg-980217.

[elisp/egg.git] / egg-com.el

diff --git a/egg-com.el b/egg-com.el
index 9604fe9..cf5b401 100644 (file)
--- a/egg-com.el
+++ b/egg-com.el
@@ -1,22 +1,23 @@
 ;;; egg-com.el --- Communication Routines in Egg Input
 ;;;                   Method Architecture
 
-;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
+;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
 ;; Laboratory, JAPAN.
 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
 
 ;; Author: Hisashi Miyashita <himi@bird.scphys.kyoto-u.ac.jp>
 ;;         NIIBE Yutaka <gniibe@mri.co.jp>
+;;        KATAYAMA Yoshio <kate@pfu.co.jp>  ; Korean, Chinese support.
 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
 
 ;; This file will be part of GNU Emacs (in future).
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; EGG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; EGG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
@@ -30,6 +31,12 @@
 
 ;;; Code:
 
+(defvar egg-fixed-euc 'fixed-euc-jp)
+(make-variable-buffer-local 'egg-fixed-euc)
+
+(defvar egg-mb-euc 'euc-japan)
+(make-variable-buffer-local 'egg-mb-euc)
+
 (eval-and-compile
 (define-ccl-program ccl-decode-fixed-euc-jp
   `(2
@@ -92,6 +99,42 @@
 
 (make-coding-system 'fixed-euc-jp 4 ?W "Coding System for fixed EUC Japanese"
                    (cons ccl-decode-fixed-euc-jp ccl-encode-fixed-euc))
+
+(eval-and-compile
+(define-ccl-program ccl-decode-fixed-euc-kr
+  `(2
+    ((r2 = ,(charset-id 'korean-ksc5601))
+     (read r0)
+     (loop
+      (read r1)
+      (if (r0 < ?\x80)
+         (r0 = r1 & ?\x7f)
+       ((write r2 r0)
+        (r0 = r1 | ?\x80)))
+      (write-read-repeat r0)))))
+
+(define-ccl-program ccl-encode-fixed-euc-kr
+  `(2
+    ((read r0)
+     (loop
+;      (if (r0 < ?\x20)
+;        (write-read-repeat r0))
+      (if (r0 < ?\x80)
+         ((write 0)
+          (write-read-repeat r0)))
+      (if (r0 == ,(charset-id 'korean-ksc5601))
+         ((read r0)
+          (r0 |= ?\x80)
+          (write r0)
+          (read r0)
+          (r0 |= ?\x80)
+          (write-read-repeat r0)))
+      (read r0)
+      (repeat)))))
+)
+
+(make-coding-system 'fixed-euc-kr 4 ?W "Coding System for fixed EUC Korean"
+                   (cons ccl-decode-fixed-euc-kr ccl-encode-fixed-euc-kr))
 \f
 (defsubst comm-format-u32c (uint32c)
   (let ((h0 (car uint32c))
@@ -137,14 +180,14 @@
 
 ;;; XXX should support other code conversion
 (defsubst comm-format-u16-string (s)
-  (let ((euc-string (encode-coding-string s 'fixed-euc-jp)))
+  (let ((euc-string (encode-coding-string s egg-fixed-euc)))
     (insert euc-string)
     (insert-char 0 1)
     (insert-char 0 1)))
 
 ;;; XXX should support other code conversion
 (defsubst comm-format-mb-string (s)
-  (let ((euc-string (encode-coding-string s 'euc-japan)))
+  (let ((euc-string (encode-coding-string s egg-mb-euc)))
     (insert euc-string)
     (insert-char 0 1)))
 
@@ -245,7 +288,7 @@ s means 8-bit string (0x00 terminated)."
     (set s (buffer-substring start
                             (+ start
                                (decode-coding-region start (- (point) 2)
-                                                     'fixed-euc-jp))))))
+                                                     egg-fixed-euc))))))
 
 ;;; XXX should support other conversion (euc-kr, cns)
 (defsubst comm-unpack-mb-string (proc s)
@@ -255,7 +298,7 @@ s means 8-bit string (0x00 terminated)."
     (set s (buffer-substring start
                             (+ start
                                (decode-coding-region start (- (point) 1)
-                                                     'euc-japan))))))
+                                                     egg-mb-euc))))))
 
 (defsubst comm-unpack-u8-string (proc s)
   (let ((start (point)))