--- a/lisp/language/ethiopic.el	Mon Aug 13 09:43:39 2007 +0200
+++ b/lisp/language/ethiopic.el	Mon Aug 13 09:44:42 2007 +0200
@@ -2,51 +2,76 @@
 
 ;; Copyright (C) 1995 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 1997 MORIOKA Tomohiko
 
 ;; Keywords: multilingual, Ethiopic
 
-;; This file is part of GNU Emacs.
+;; This file is part of XEmacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
+;; XEmacs 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,
-;; 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.
+;; XEmacs 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.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
 ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+;;         modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> for XEmacs.
 
 ;;; Code:
 
+;; Ethiopic
+(make-charset 'ethiopic "Ethiopic"
+	      '(registry "Ethio"
+		dimension 2
+		chars 94
+		final ?3
+		graphic 0
+		))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ETHIOPIC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-category ?E "Ethiopic (Ge'ez) character.")
+(modify-category-entry 'ethiopic ?E)
+
+;; (define-ccl-program ccl-encode-ethio-font
+;;   '(0
+;;     ;; In:  R0:ethiopic (not checked)
+;;     ;;      R1:position code 1
+;;     ;;      R2:position code 2
+;;     ;; Out: R1:font code point 1
+;;     ;;      R2:font code point 2
+;;     ((r1 -= 33)
+;;      (r2 -= 33)
+;;      (r1 *= 94)
+;;      (r2 += r1)
+;;      (if (r2 < 256)
+;;          (r1 = ?\x12)
+;;        (if (r2 < 448)
+;;            ((r1 = ?\x13) (r2 -= 256))
+;;          ((r1 = ?\xfd) (r2 -= 208))
+;;          ))))
+;;   "CCL program to encode an Ehitopic code to code point of Ehitopic font.")
 (define-ccl-program ccl-encode-ethio-font
-  '(0
-    ;; In:  R0:ethiopic (not checked)
-    ;;      R1:position code 1
-    ;;      R2:position code 2
-    ;; Out: R1:font code point 1
-    ;;      R2:font code point 2
-    ((r1 -= 33)
-     (r2 -= 33)
-     (r1 *= 94)
-     (r2 += r1)
-     (if (r2 < 256)
-	 (r1 = ?\x12)
-       (if (r2 < 448)
-	   ((r1 = ?\x13) (r2 -= 256))
-	 ((r1 = ?\xfd) (r2 -= 208))
-	 ))))
-  "CCL program to encode an Ehitopic code to code point of Ehitopic font.")
+  '(((r0 -= #x21)
+     (r1 -= #x21)
+     (r0 *= 94)
+     (r1 += r0)
+     (if (r1 < 256) (r0 = 0) ((r1 -= 256) (r0 = 1))))))
 
-(setq font-ccl-encoder-alist
-      (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist))
+;; (setq font-ccl-encoder-alist
+;;       (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist))
+(set-charset-ccl-program 'ethiopic ccl-encode-ethio-font)
 
 (register-input-method
  "Ethiopic" '("quail-ethio" quail-use-package "quail/ethiopic"))
@@ -97,4 +122,11 @@
 	      (sample-text . "$(3$O#U!.(B")
 	      (documentation . nil)))
 
+;; for XEmacs (will be obsoleted)
+(define-language-environment 'ethiopic
+  "Ethiopic"
+  #'(lambda ()
+      (setq-default quail-current-package
+		    (assoc "ethio" quail-package-alist))))
+
 ;;; ethiopic.el ends here