Mercurial > hg > xemacs-beta
view lisp/language/ethiopic.el @ 191:ecf6ba7b0a10 r20-3b22
Import from CVS: tag r20-3b22
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:57:38 +0200 |
parents | 5a88923fcbfe |
children |
line wrap: on
line source
;;; ethiopic.el --- Support for Ethiopic ;; 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 XEmacs. ;; 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. ;; 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 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 '(((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)) (set-charset-ccl-program 'ethiopic ccl-encode-ethio-font) (register-input-method "Ethiopic" '("quail-ethio" quail-use-package "quail/ethiopic")) (defun setup-ethiopic-environment () "Setup multilingual environment for Ethiopic." (interactive) (setq primary-language "Ethiopic") (setq default-input-method '("Ethiopic" . "quail-ethio")) ;; ;; key bindings ;; (define-key global-map [f4] 'sera-to-fidel-buffer) (define-key global-map [S-f4] 'sera-to-fidel-region) (define-key global-map [C-f4] 'sera-to-fidel-marker) (define-key global-map [f5] 'fidel-to-sera-buffer) (define-key global-map [S-f5] 'fidel-to-sera-region) (define-key global-map [C-f5] 'fidel-to-sera-marker) (define-key global-map [f6] 'ethio-modify-vowel) (define-key global-map [f7] 'ethio-replace-space) (define-key global-map [f8] 'ethio-input-special-character) (define-key global-map [S-f2] 'ethio-replace-space) ; as requested (add-hook 'rmail-mode-hook '(lambda () (define-key rmail-mode-map [C-f4] 'sera-to-fidel-mail) (define-key rmail-mode-map [C-f5] 'fidel-to-sera-mail))) (add-hook 'mail-mode-hook '(lambda () (define-key mail-mode-map [C-f4] 'sera-to-fidel-mail) (define-key mail-mode-map [C-f5] 'fidel-to-sera-mail))) ) (defun describe-ethiopic-support () "Describe how Emacs supports Ethiopic." (interactive) (describe-language-support-internal "Ethiopic")) (set-language-info-alist "Ethiopic" '((setup-function . setup-ethiopic-environment) (describe-function . describe-ethiopic-support) (charset . (ethiopic)) (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