X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=egg-com.el;fp=egg-com.el;h=cf5b401606a4243d50d1e8837030a4910080b9d0;hb=4f60a801e4c8a70a1eb7299c4fdd6f8c75f8528f;hp=9604fe9fe98ea578c17f2880dcc3d222f907c385;hpb=051cd863eb34b98b099d4c8ccfd4327b4de9564c;p=elisp%2Fegg.git diff --git a/egg-com.el b/egg-com.el index 9604fe9..cf5b401 100644 --- 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 ;; Author: Hisashi Miyashita ;; NIIBE Yutaka +;; KATAYAMA Yoshio ; Korean, Chinese support. ;; Maintainer: NIIBE Yutaka ;; 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)) (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)))