From 68702138198165358a9d975bf552c5eef98afa71 Mon Sep 17 00:00:00 2001 From: tomo Date: Thu, 1 Apr 1999 12:44:50 +0000 Subject: [PATCH] Initial revision --- lisp/mule/chinese.el | 268 +++++++++++++++++ lisp/mule/japanese.el | 232 +++++++++++++++ lisp/mule/misc-lang.el | 52 ++++ lisp/mule/mule-category.el | 286 ++++++++++++++++++ lisp/mule/mule-charset.el | 142 +++++++++ lisp/mule/mule-cmds.el | 706 ++++++++++++++++++++++++++++++++++++++++++++ lisp/mule/mule-coding.el | 188 ++++++++++++ lisp/mule/mule-files.el | 35 +++ lisp/mule/viet-chars.el | 57 ++++ 9 files changed, 1966 insertions(+) create mode 100644 lisp/mule/chinese.el create mode 100644 lisp/mule/japanese.el create mode 100644 lisp/mule/misc-lang.el create mode 100644 lisp/mule/mule-category.el create mode 100644 lisp/mule/mule-charset.el create mode 100644 lisp/mule/mule-cmds.el create mode 100644 lisp/mule/mule-coding.el create mode 100644 lisp/mule/mule-files.el create mode 100644 lisp/mule/viet-chars.el diff --git a/lisp/mule/chinese.el b/lisp/mule/chinese.el new file mode 100644 index 0000000..a4fd892 --- /dev/null +++ b/lisp/mule/chinese.el @@ -0,0 +1,268 @@ +;;; chinese.el --- Support for Chinese + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: multilingual, Chinese + +;; 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. + +;;; Commentary: + +;; For Chinese, three character sets GB2312, BIG5, and CNS11643 are +;; supported. + +;;; Code: + +;; Syntax of Chinese characters. +(modify-syntax-entry 'chinese-gb2312 "w") +(loop for row in '(33 34 41) + do (modify-syntax-entry `[chinese-gb2312 ,row] ".")) +;;(loop for row from 35 to 40 +;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w")) +;;(loop for row from 42 to 126 +;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w")) + +(modify-syntax-entry 'chinese-cns11643-1 "w") +(modify-syntax-entry 'chinese-cns11643-2 "w") +(modify-syntax-entry 'chinese-big5-1 "w") +(modify-syntax-entry 'chinese-big5-2 "w") + +;; CNS11643 Plane3 thru Plane7 +;; These represent more and more obscure Chinese characters. +;; By the time you get to Plane 7, we're talking about characters +;; that appear once in some ancient manuscript and whose meaning +;; is unknown. + +(flet + ((make-chinese-cns11643-charset + (name plane final) + (make-charset + name (concat "CNS 11643 Plane " plane " (Chinese traditional)") + `(registry + ,(concat "CNS11643[.-]\\(.*[.-]\\)?" plane "$") + dimension 2 + chars 94 + final ,final + graphic 0)) + (modify-syntax-entry name "w") + (modify-category-entry name ?t) + )) + (make-chinese-cns11643-charset 'chinese-cns11643-3 "3" ?I) + (make-chinese-cns11643-charset 'chinese-cns11643-4 "4" ?J) + (make-chinese-cns11643-charset 'chinese-cns11643-5 "5" ?K) + (make-chinese-cns11643-charset 'chinese-cns11643-6 "6" ?L) + (make-chinese-cns11643-charset 'chinese-cns11643-7 "7" ?M) + ) + +;; ISO-IR-165 (CCITT Extended GB) +;; It is based on CCITT Recommendation T.101, includes GB 2312-80 + +;; GB 8565-88 table A4 + 293 characters. +(make-charset + 'chinese-isoir165 + "ISO-IR-165 (CCITT Extended GB; Chinese simplified)" + `(registry "isoir165" + dimension 2 + chars 94 + final ?E + graphic 0)) + +;; PinYin-ZhuYin +(make-charset 'sisheng "PinYin-ZhuYin" + '(registry "sisheng_cwnn\\|OMRON_UDC_ZH" + dimension 1 + chars 94 + final ?0 + graphic 0 + )) + +;; If you prefer QUAIL to EGG, please modify below as you wish. +;;(when (and (featurep 'egg) (featurep 'wnn)) +;; (setq wnn-server-type 'cserver) +;; (load "pinyin") +;; (setq its:*standard-modes* +;; (cons (its:get-mode-map "PinYin") its:*standard-modes*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Chinese (general) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (make-coding-system +;; 'chinese-iso-7bit 2 ?C +;; "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)" +;; '(ascii +;; (nil chinese-gb2312 chinese-cns11643-1) +;; (nil chinese-cns11643-2) +;; (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 +;; chinese-cns11643-6 chinese-cns11643-7) +;; nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil +;; init-bol)) + +;; (define-coding-system-alias 'iso-2022-cn 'chinese-iso-7bit) +;; (define-coding-system-alias 'iso-2022-cn-ext 'chinese-iso-7bit) + +;; (define-prefix-command 'describe-chinese-environment-map) +;; (define-key-after describe-language-environment-map [Chinese] +;; '("Chinese" . describe-chinese-environment-map) +;; t) + +;; (define-prefix-command 'setup-chinese-environment-map) +;; (define-key-after setup-language-environment-map [Chinese] +;; '("Chinese" . setup-chinese-environment-map) +;; t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Chinese GB2312 (simplified) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (make-coding-system +;; 'chinese-iso-8bit 2 ?c +;; "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:CN-GB-2312)" +;; '((ascii t) chinese-gb2312 chinese-sisheng nil +;; nil ascii-eol ascii-cntl nil nil single-shift nil)) + +(make-coding-system + 'cn-gb-2312 'iso2022 + "Coding-system of Chinese EUC (Extended Unix Code)." + '(charset-g0 ascii + charset-g1 chinese-gb2312 + charset-g2 sisheng + charset-g3 t + mnemonic "Zh-GB/EUC" + )) + +;; (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit) +;; (define-coding-system-alias 'euc-china 'chinese-iso-8bit) + +(copy-coding-system 'cn-gb-2312 'gb2312) +(copy-coding-system 'cn-gb-2312 'chinese-euc) + +;; (make-coding-system +;; 'chinese-hz 0 ?z +;; "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)" +;; nil) +;; (put 'chinese-hz 'post-read-conversion 'post-read-decode-hz) +;; (put 'chinese-hz 'pre-write-conversion 'pre-write-encode-hz) + +(make-coding-system + 'hz-gb-2312 'no-conversion + "Coding-system of Hz/ZW used for Chinese." + '(mnemonic "Zh-GB/Hz" + eol-type lf + post-read-conversion post-read-decode-hz + pre-write-conversion pre-write-encode-hz)) + +;; (define-coding-system-alias 'hz-gb-2312 'chinese-hz) +;; (define-coding-system-alias 'hz 'chinese-hz) + +(copy-coding-system 'hz-gb-2312 'hz) +(copy-coding-system 'hz-gb-2312 'chinese-hz) + +(defun post-read-decode-hz (len) + (let ((pos (point))) + (decode-hz-region pos (+ pos len)))) + +(defun pre-write-encode-hz (from to) + (let ((buf (current-buffer)) + (work (get-buffer-create " *pre-write-encoding-work*"))) + (set-buffer work) + (erase-buffer) + (if (stringp from) + (insert from) + (insert-buffer-substring buf from to)) + (encode-hz-region 1 (point-max)) + nil)) + +(set-language-info-alist + "Chinese-GB" '((setup-function . (setup-chinese-gb-environment + . setup-chinese-environment-map)) + (charset . (chinese-gb2312 sisheng)) + (coding-system + . (cn-gb-2312 iso-2022-7bit hz-gb-2312)) + (sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B") + (documentation . ("Support for Chinese GB2312 character set." + . describe-chinese-environment-map)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Chinese BIG5 (traditional) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (make-coding-system +;; 'chinese-big5 3 ?B "BIG5 8-bit encoding for Chinese (MIME:CN-BIG5)") + +(make-coding-system + 'big5 'big5 + "Coding-system of BIG5." + '(mnemonic "Zh/Big5")) + +;; (define-coding-system-alias 'big5 'chinese-big5) +;; (define-coding-system-alias 'cn-big5 'chinese-big5) + +(copy-coding-system 'big5 'cn-big5) +(copy-coding-system 'big5 'chinese-big5) + +;; Big5 font requires special encoding. +(define-ccl-program ccl-encode-big5-font + `(0 + ;; In: R0:chinese-big5-1 or chinese-big5-2 + ;; R1:position code 1 + ;; R2:position code 2 + ;; Out: R1:font code point 1 + ;; R2:font code point 2 + ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21)) + (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280)) + (r1 = ((r2 / 157) + ?\xA1)) + (r2 %= 157) + (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62)))) + "CCL program to encode a Big5 code to code point of Big5 font.") + +;; (setq font-ccl-encoder-alist +;; (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist)) + +(set-charset-ccl-program 'chinese-big5-1 ccl-encode-big5-font) +(set-charset-ccl-program 'chinese-big5-2 ccl-encode-big5-font) + +(set-language-info-alist + "Chinese-BIG5" '((setup-function . (setup-chinese-big5-environment + . setup-chinese-environment-map)) + (charset . (chinese-big5-1 chinese-big5-2)) + (coding-system . (big5 iso-2022-7bit)) + (sample-text . "Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B") + (documentation . ("Support for Chinese Big5 character set." + . describe-chinese-environment-map)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Chinese CNS11643 (traditional) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (set-language-info-alist +;; "Chinese-CNS" '((setup-function . (setup-chinese-cns-environment +;; . setup-chinese-environment-map)) +;; (charset . (chinese-cns11643-1 chinese-cns11643-2 +;; chinese-cns11643-3 chinese-cns11643-4 +;; chinese-cns11643-5 chinese-cns11643-6 +;; chinese-cns11643-7)) +;; (coding-system . (chinese-iso-7bit)) +;; (documentation . ("Support for Chinese CNS character sets." +;; . describe-chinese-environment-map)) +;; )) + +;;; chinese.el ends here diff --git a/lisp/mule/japanese.el b/lisp/mule/japanese.el new file mode 100644 index 0000000..fbc7328 --- /dev/null +++ b/lisp/mule/japanese.el @@ -0,0 +1,232 @@ +;;; japanese.el --- Japanese support + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: multilingual, Japanese + +;; 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. + +;;; Commentary: + +;; For Japanese, character sets JISX0201, JISX0208, JISX0212 are +;; supported. + +;;; Code: + +;;; Syntax of Japanese characters. +(modify-syntax-entry 'katakana-jisx0201 "w") +(modify-syntax-entry 'japanese-jisx0212 "w") + +(modify-syntax-entry 'japanese-jisx0208 "w") +(loop for row in '(33 34 40) + do (modify-syntax-entry `[japanese-jisx0208 ,row] "_")) +(loop for char in '(?$B!<(B ?$B!+(B ?$B!,(B ?$B!3(B ?$B!4(B ?$B!5(B ?$B!6(B ?$B!7(B ?$B!8(B ?$B!9(B ?$B!:(B ?$B!;(B) + do (modify-syntax-entry char "w")) +(modify-syntax-entry ?\$B!J(B "($B!K(B") +(modify-syntax-entry ?\$B!N(B "($B!O(B") +(modify-syntax-entry ?\$B!P(B "($B!Q(B") +(modify-syntax-entry ?\$B!V(B "($B!W(B") +(modify-syntax-entry ?\$B!X(B "($B!Y(B") +(modify-syntax-entry ?\$B!K(B ")$B!J(B") +(modify-syntax-entry ?\$B!O(B ")$B!N(B") +(modify-syntax-entry ?\$B!Q(B ")$B!P(B") +(modify-syntax-entry ?\$B!W(B ")$B!V(B") +(modify-syntax-entry ?\$B!Y(B ")$B!X(B") + +;;; Character categories S, A, H, K, G, Y, and C +(define-category ?S "Japanese 2-byte symbol character.") +(modify-category-entry [japanese-jisx0208 33] ?S) +(modify-category-entry [japanese-jisx0208 34] ?S) +(modify-category-entry [japanese-jisx0208 40] ?S) +(define-category ?A "Japanese 2-byte Alphanumeric character.") +(modify-category-entry [japanese-jisx0208 35] ?A) +(define-category ?H "Japanese 2-byte Hiragana character.") +(modify-category-entry [japanese-jisx0208 36] ?H) +(define-category ?K "Japanese 2-byte Katakana character.") +(modify-category-entry [japanese-jisx0208 37] ?K) +(define-category ?G "Japanese 2-byte Greek character.") +(modify-category-entry [japanese-jisx0208 38] ?G) +(define-category ?Y "Japanese 2-byte Cyrillic character.") +(modify-category-entry [japanese-jisx0208 39] ?Y) +(define-category ?C "Japanese 2-byte Kanji characters.") +(loop for row from 48 to 126 + do (modify-category-entry `[japanese-jisx0208 ,row] ?C)) +(loop for char in '(?$B!<(B ?$B!+(B ?$B!,(B) + do (modify-category-entry char ?K) + (modify-category-entry char ?H)) +(loop for char in '(?$B!3(B ?$B!4(B ?$B!5(B ?$B!6(B ?$B!7(B ?$B!8(B ?$B!9(B ?$B!:(B ?$B!;(B) + do (modify-category-entry char ?C)) +(modify-category-entry 'japanese-jisx0212 ?C) + +(defvar japanese-word-regexp + "\\cA+\\cH*\\|\\cK+\\cH*\\|\\cC+\\cH*\\|\\cH+\\|\\ck+\\|\\sw+" + "Regular expression used to match a Japanese word.") + +(set-word-regexp japanese-word-regexp) +(setq forward-word-regexp "\\w\\>") +(setq backward-word-regexp "\\<\\w") + +;;; Paragraph setting +(setq sentence-end + (concat + "\\(" + "\\(" + "[.?!][]\"')}]*" + "\\|" + "[$B!%!)!*(B][$B!O!I!G!K!Q!M!S!U!W!Y(B]*" + "\\)" + "\\($\\|\t\\| \\)" + "\\|" + "$B!#(B" + "\\)" + "[ \t\n]*")) +(setq paragraph-start "^[ $B!!(B\t\n\f]") +(setq paragraph-separate "^[ $B!!(B\t\f]*$") + +;; EGG specific setup +(define-egg-environment 'japanese + "Japanese settings for egg." + (lambda () + (when (not (featurep 'egg-jpn)) + (load "its-hira") + (load "its-kata") + (load "its-hankaku") + (load "its-zenkaku") + (setq its:*standard-modes* + (append + (list (its:get-mode-map "roma-kana") + (its:get-mode-map "roma-kata") + (its:get-mode-map "downcase") + (its:get-mode-map "upcase") + (its:get-mode-map "zenkaku-downcase") + (its:get-mode-map "zenkaku-upcase")) + its:*standard-modes*)) + (provide 'egg-jpn)) + (setq wnn-server-type 'jserver) + ;; Can't do this here any more. Must do it when selecting egg-wnn + ;; or egg-sj3 + ;; (setq egg-default-startup-file "eggrc-wnn") + (setq-default its:*current-map* (its:get-mode-map "roma-kana")))) + +;; stuff for providing gramatic processing of Japanese text +;; something like this should probably be created for all environments... + +(defvar aletter (concat "\\(" ascii-char "\\|" kanji-char "\\)")) +(defvar kanji-space-insertable (concat + "$B!"(B" aletter "\\|" + "$B!#(B" aletter "\\|" + aletter "$B!J(B" "\\|" + "$B!K(B" aletter "\\|" + ascii-alphanumeric kanji-kanji-char "\\|" + kanji-kanji-char ascii-alphanumeric )) + +(defvar space-insertable (concat " " aletter "\\|" kanji-space-insertable) + "Regexp for finding points that can have spaces inserted into them for justification") + +;; (make-coding-system +;; 'iso-2022-jp 2 ?J +;; "ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)" +;; '((ascii japanese-jisx0208-1978 japanese-jisx0208 +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 t) nil nil nil +;; short ascii-eol ascii-cntl seven)) + +;; (define-coding-system-alias 'junet 'iso-2022-jp) + +(make-coding-system + 'iso-2022-jp 'iso2022 + "Coding-system used for communication with mail and news in Japan." + '(charset-g0 ascii + short t + seven t + input-charset-conversion ((latin-jisx0201 ascii) + (japanese-jisx0208-1978 japanese-jisx0208)) + mnemonic "MULE/7bit" + )) + +(copy-coding-system 'iso-2022-jp 'junet) + +;; (make-coding-system +;; 'shift_jis 1 ?S +;; "Coding-system of Shift-JIS used in Japan." t) + +(make-coding-system + 'shift_jis 'shift-jis + "Coding-system of Shift-JIS used in Japan." + '(mnemonic "Ja/SJIS")) + +;;(define-coding-system-alias 'shift_jis 'sjis) + +(copy-coding-system 'shift_jis 'sjis) + +;; (make-coding-system +;; 'iso-2022-jp-1978-irv 2 ?J +;; "Coding-system used for old jis terminal." +;; '((ascii t) nil nil nil +;; short ascii-eol ascii-cntl seven nil nil use-roman use-oldjis)) + +(make-coding-system + 'iso-2022-jp-1978-irv 'iso2022 + "Coding-system used for old JIS terminal." + '(charset-g0 ascii + short t + seven t + output-charset-conversion ((ascii latin-jisx0201) + (japanese-jisx0208 japanese-jisx0208-1978)) + mnemonic "Ja-78/7bit" + )) + +;;(define-coding-system-alias 'iso-2022-jp-1978-irv 'old-jis) + +(copy-coding-system 'iso-2022-jp-1978-irv 'old-jis) + +;; (make-coding-system +;; 'euc-japan-1990 2 ?E +;; "Coding-system of Japanese EUC (Extended Unix Code)." +;; '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212 +;; short ascii-eol ascii-cntl nil nil single-shift)) + +(make-coding-system + 'euc-jp 'iso2022 + "Coding-system of Japanese EUC (Extended Unix Code)." + '(charset-g0 ascii + charset-g1 japanese-jisx0208 + charset-g2 katakana-jisx0201 + charset-g3 japanese-jisx0212 + short t + mnemonic "Ja/EUC" + )) + +;;(define-coding-system-alias 'euc-japan-1990 'euc-japan) + +(copy-coding-system 'euc-jp 'euc-japan) ; only for w3 +(copy-coding-system 'euc-jp 'japanese-euc) + +(set-language-info-alist + "Japanese" '((setup-function . setup-japanese-environment) + (tutorial . "TUTORIAL.ja") + (charset . (japanese-jisx0208 japanese-jisx0208-1978 + japanese-jisx0212 latin-jisx0201 + katakana-jisx0201)) + (coding-system . (iso-2022-jp euc-jp + shift_jis iso-2022-jp-1978-irv)) + (sample-text . "Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B") + (documentation . t))) + +;;; japanese.el ends here diff --git a/lisp/mule/misc-lang.el b/lisp/mule/misc-lang.el new file mode 100644 index 0000000..236f9b0 --- /dev/null +++ b/lisp/mule/misc-lang.el @@ -0,0 +1,52 @@ +;;; misc-lang.el --- support for miscellaneous languages (characters) + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: multilingual, character set, coding system + +;; 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. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IPA (International Phonetic Alphabet) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(make-charset 'ipa "International Phonetic Alphabet" + '(registry "MuleIPA" + dimension 1 + chars 96 + final ?0 + graphic 1 + )) ; for XEmacs + +(defun setup-ipa-environment () + "Setup multilingual environment (MULE) for IPA." + (interactive) + (setup-english-environment)) + +(set-language-info-alist + "IPA" '((setup-function . setup-ipa-environment) + (charset . (ipa)) + (documentation . "\ +IPA is International Phonetic Alphabet for English, French, German +and Italian."))) + +;;; misc-lang.el ends here diff --git a/lisp/mule/mule-category.el b/lisp/mule/mule-category.el new file mode 100644 index 0000000..bcc1e03 --- /dev/null +++ b/lisp/mule/mule-category.el @@ -0,0 +1,286 @@ +;;; mule-category.el --- category functions for XEmacs/Mule. + +;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. + +;; 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. + +;;; Commentary: + +;; Functions for working with category tables, which are a particular +;; type of char table. Some function names / arguments should be +;; parallel with syntax tables. + +;; Written by Ben Wing . The initialization code +;; at the end of this file comes from Mule. +;; Some bugfixes by Jareth Hein + +;;; Code: + +(defvar defined-category-hashtable (make-hashtable 50)) + +(defun define-category (designator doc-string) + "Make a new category whose designator is DESIGNATOR. +DESIGNATOR should be a visible letter of ' ' thru '~'. +STRING is a doc string for the category. +Letters of 'a' thru 'z' are already used or kept for the system." + (check-argument-type 'category-designator-p designator) + (check-argument-type 'stringp doc-string) + (puthash designator doc-string defined-category-hashtable)) + +(defun undefine-category (designator) + "Undefine DESIGNATOR as a designator for a category." + (check-argument-type 'category-designator-p designator) + (remhash designator defined-category-hashtable)) + +(defun defined-category-p (designator) + "Return non-nil if DESIGNATOR is a designator for a defined category." + (and (category-designator-p designator) + (gethash designator defined-category-hashtable))) + +(defun defined-category-list () + "Return a list of the currently defined categories. +Categories are given by their designators." + (let (list) + (maphash #'(lambda (key value) + (setq list (cons key list))) + defined-category-hashtable) + (nreverse list))) + +(defun undefined-category-designator () + "Return an undefined category designator, or nil if there are none." + (let ((a 32) found) + (while (and (< a 127) (not found)) + (if (gethash a defined-category-hashtable) + (setq found a)) + (setq a (1+ a))) + found)) + +(defun category-doc-string (designator) + "Return the doc-string for the category denoted by DESIGNATOR." + (check-argument-type 'defined-category-p designator) + (gethash designator defined-category-hashtable)) + +(defun modify-category-entry (char-range designator &optional table reset) + "Add a category to the categories associated with CHAR-RANGE. +CHAR-RANGE is a single character or a range of characters, + as per `put-char-table'. +The category is given by a designator character. +The changes are made in TABLE, which defaults to the current buffer's + category table. +If optional fourth argument RESET is non-nil, previous categories associated + with CHAR-RANGE are removed before adding the specified category." + (or table (setq table (category-table))) + (check-argument-type 'category-table-p table) + (check-argument-type 'defined-category-p designator) + (if reset + ;; clear all existing stuff. + (put-char-table char-range nil table)) + (map-char-table + #'(lambda (key value) + ;; make sure that this range has a bit-vector assigned to it + (if (not (bit-vector-p value)) + (setq value (make-bit-vector 95 0)) + (setq value (copy-sequence value))) + ;; set the appropriate bit in that vector. + (aset value (- designator 32) 1) + ;; put the vector back, thus assuring we have a unique setting for this range + (put-char-table key value table)) + table char-range)) + +(defun char-category-list (char &optional table) + "Return a list of the categories that CHAR is in. +TABLE defaults to the current buffer's category table. +The categories are given by their designators." + (or table (setq table (category-table))) + (check-argument-type 'category-table-p table) + (let ((vec (get-char-table char table))) + (if (null vec) nil + (let ((a 32) list) + (while (< a 127) + (if (= 1 (aref vec (- a 32))) + (setq list (cons a list))) + (setq a (1+ a))) + (nreverse list))))) + +;; implimented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) +;(defun char-in-category-p (char category &optional table) +; "Return non-nil if CHAR is in CATEGORY. +;TABLE defaults to the current buffer's category table. +;Categories are specified by their designators." +; (or table (setq table (category-table))) +; (check-argument-type 'category-table-p table) +; (check-argument-type 'category-designator-p category) +; (let ((vec (get-char-table char table))) +; (if (null vec) nil +; (= 1 (aref vec (- category 32)))))) + +(defun describe-category () + "Describe the category specifications in the category table. +The descriptions are inserted in a buffer, which is then displayed." + (interactive) + (with-output-to-temp-buffer "*Help*" + (describe-category-table (category-table) standard-output))) + +(defun describe-category-table (table stream) + (let (first-char + last-char + prev-val + (describe-one + (lambda (first last value stream) + (if (and (bit-vector-p value) + (> (reduce '+ value) 0)) + (progn + (if (equal first last) + (cond ((vectorp first) + (princ (format "%s, row %d" + (charset-name + (aref first 0)) + (aref first 1)) + stream)) + ((charsetp first) + (princ (charset-name first) stream)) + (t (princ first stream))) + (cond ((vectorp first) + (princ (format "%s, rows %d .. %d" + (charset-name + (aref first 0)) + (aref first 1) + (aref last 1)) + stream)) + (t + (princ (format "%s .. %s" first last) + stream)))) + (describe-category-code value stream)))))) + (map-char-table + (lambda (range value) + (if (and (or + (and (characterp range) + (characterp first-char) + (eq (char-charset range) (char-charset first-char)) + (= (char-to-int last-char) (1- (char-to-int range)))) + (and (vectorp range) + (vectorp first-char) + (eq (aref range 0) (aref first-char 0)) + (= (aref last-char 1) (1- (aref range 1)))) + (equal value prev-val))) + (setq last-char range) + (if first-char + (progn + (funcall describe-one first-char last-char prev-val stream) + (setq first-char nil))) + (funcall describe-one range range value stream)) + nil) + table) + (if first-char + (funcall describe-one first-char last-char prev-val stream)))) + +(defun describe-category-code (code stream) + (let ((standard-output (or stream standard-output))) + (princ "\tin categories: ") + (if (not (bit-vector-p code)) + (princ "(none)") + (let ((i 0) + already-matched) + (while (< i 95) + (if (= 1 (aref code i)) + (progn + (if (not already-matched) + (setq already-matched t) + (princ " ")) + (princ (int-to-char (+ 32 i))))) + (setq i (1+ i))) + (if (not already-matched) + (princ "(none)"))) + (let ((i 0)) + (while (< i 95) + (if (= 1 (aref code i)) + (princ (format "\n\t\tmeaning: %s" + (category-doc-string (int-to-char (+ 32 i)))))) + (setq i (1+ i))))) + (terpri))) + +(defconst predefined-category-list + '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set") + (latin-iso8859-2 ?l) + (latin-iso8859-3 ?l) + (latin-iso8859-4 ?l) + (latin-iso8859-9 ?l) + (cyrillic-iso8859-5 ?y "Cyrillic character set") + (arabic-iso8859-6 ?b "Arabic character set") + (greek-iso8859-7 ?g "Greek character set") + (hebrew-iso8859-8 ?w "Hebrew character set") + (katakana-jisx0201 ?k "Japanese 1-byte Katakana character set") + (latin-jisx0201 ?r "Japanese 1-byte Roman character set") + (japanese-jisx0208-1978 ?j "Japanese 2-byte character set (old)") + (japanese-jisx0208 ?j "Japanese 2-byte character set") + (japanese-jisx0212 ?j) + (chinese-gb2312 ?c "Chinese GB (China, PRC) 2-byte character set") + (chinese-cns11643-1 ?t "Chinese Taiwan (CNS or Big5) 2-byte character set") + (chinese-cns11643-2 ?t) + (chinese-big5-1 ?t) + (chinese-big5-2 ?t) + (korean-ksc5601 ?h "Hangul (Korean) 2-byte character set") + ) + "List of predefined categories. +Each element is a list of a charset, a designator, and maybe a doc string.") + +(let (i l) + (define-category ?a "ASCII character set.") + (setq i 32) + (while (< i 127) + (modify-category-entry i ?a) + (setq i (1+ i))) + (setq l predefined-category-list) + (while l + (if (and (nth 2 (car l)) + (not (defined-category-p (nth 2 (car l))))) + (define-category (nth 1 (car l)) (nth 2 (car l)))) + (modify-category-entry (car (car l)) (nth 1 (car l))) + (setq l (cdr l)))) + +;;; At the present, I know Japanese and Chinese text can +;;; break line at any point under a restriction of 'kinsoku'. +(defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" + "Regular expression of such characters which can be a word across newline.") + +(defvar ascii-char "[\40-\176]") +(defvar ascii-space "[ \t]") +(defvar ascii-symbols "[\40-\57\72-\100\133-\140\173-\176]") +(defvar ascii-numeric "[\60-\71]") +(defvar ascii-English-Upper "[\101-\132]") +(defvar ascii-English-Lower "[\141-\172]") +(defvar ascii-alphanumeric "[\60-\71\101-\132\141-\172]") + +(defvar kanji-char "\\cj") +(defvar kanji-space "$B!!(B") +(defvar kanji-symbols "\\cS") +(defvar kanji-numeric "[$B#0(B-$B#9(B]") +(defvar kanji-English-Upper "[$B#A(B-$B#Z(B]") +(defvar kanji-English-Lower "[$B#a(B-$B#z(B]") +(defvar kanji-hiragana "\\cH") +(defvar kanji-katakana "\\cK") +(defvar kanji-Greek-Upper "[$B&!(B-$B&8(B]") +(defvar kanji-Greek-Lower "[$B&A(B-$B&X(B]") +(defvar kanji-Russian-Upper "[$B'!(B-$B'A(B]") +(defvar kanji-Russian-Lower "[$B'Q(B-$B'q(B]") +(defvar kanji-Kanji-1st-Level "[$B0!(B-$BOS(B]") +(defvar kanji-Kanji-2nd-Level "[$BP!(B-$Bt$(B]") + +(defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)") diff --git a/lisp/mule/mule-charset.el b/lisp/mule/mule-charset.el new file mode 100644 index 0000000..6e3c366 --- /dev/null +++ b/lisp/mule/mule-charset.el @@ -0,0 +1,142 @@ +;;; mule-charset.el --- Charset functions for Mule. +;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1996 Sun Microsystems. + +;; 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. + + +;;;; Composite character support + +(defun compose-region (start end &optional buffer) + "Compose characters in the current region into one composite character. +From a Lisp program, pass two arguments, START to END. +The composite character replaces the composed characters. +BUFFER defaults to the current buffer if omitted." + (interactive "r") + (let ((ch (make-composite-char (buffer-substring start end buffer)))) + (delete-region start end buffer) + (insert-char ch nil nil buffer))) + +(defun decompose-region (start end &optional buffer) + "Decompose any composite characters in the current region. +From a Lisp program, pass two arguments, START to END. +This converts each composite character into one or more characters, +the individual characters out of which the composite character was formed. +Non-composite characters are left as-is. BUFFER defaults to the current +buffer if omitted." + (interactive "r") + (save-excursion + (set-buffer buffer) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let ((compcharset (get-charset 'composite))) + (while (< (point) (point-max)) + (let ((ch (char-after (point)))) + (if (eq compcharset (char-charset ch)) + (progn + (delete-char 1) + (insert (composite-char-string ch)))))))))) + + +;;;; Classifying text according to charsets + +(defun charsets-in-region (start end &optional buffer) + "Return a list of the charsets in the region between START and END. +BUFFER defaults to the current buffer if omitted." + (let (list) + (save-excursion + (if buffer + (set-buffer buffer)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (not (eobp)) + (let* (prev-charset + (ch (char-after (point))) + (charset (char-charset ch))) + (if (not (eq prev-charset charset)) + (progn + (setq prev-charset charset) + (or (memq charset list) + (setq list (cons charset list)))))) + (forward-char)))) + list)) + +(defun charsets-in-string (string) + "Return a list of the charsets in STRING." + (let ((i 0) + (len (length string)) + prev-charset charset list) + (while (< i len) + (setq charset (char-charset (aref string i))) + (if (not (eq prev-charset charset)) + (progn + (setq prev-charset charset) + (or (memq charset list) + (setq list (cons charset list))))) + (setq i (1+ i))) + list)) + + +;;;; Charset accessors + +(defun charset-graphic (charset) + "Return the `graphic' property of CHARSET. +See `make-charset'." + (charset-property charset 'graphic)) + +(defun charset-final (charset) + "Return the final byte of the ISO 2022 escape sequence designating CHARSET." + (charset-property charset 'final)) + +(defun charset-chars (charset) + "Return the number of characters per dimension of CHARSET." + (charset-property charset 'chars)) + +(defun charset-columns (charset) + "Return the number of display columns per character of CHARSET. +This only applies to TTY mode (under X, the actual display width can +be automatically determined)." + (charset-property charset 'columns)) + +(defun charset-direction (charset) + "Return the display direction (`l2r' or `r2l') of CHARSET." + (charset-property charset 'direction)) + +(defun charset-registry (charset) + "Return the registry of CHARSET. +This is a regular expression matching the registry field of fonts +that can display the characters in CHARSET." + (charset-property charset 'registry)) + +(defun charset-ccl-program (charset) + "Return the CCL program of CHARSET. +See `make-charset'." + (charset-property charset 'ccl-program)) + +(defun charset-leading-byte (charset) + "Return the leading byte of CHARSET. +See `make-charset'." + (charset-property charset 'leading-byte)) + +;;;; Define setf methods for all settable Charset properties + +(defsetf charset-registry set-charset-registry) +(defsetf charset-ccl-program set-charset-ccl-program) diff --git a/lisp/mule/mule-cmds.el b/lisp/mule/mule-cmds.el new file mode 100644 index 0000000..832bf97 --- /dev/null +++ b/lisp/mule/mule-cmds.el @@ -0,0 +1,706 @@ +;;; mule-cmds.el --- Commands for multilingual environment + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: mule, multilingual + +;; 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. + +;;; Code: + +;;; MULE related key bindings and menus. + +(defvar mule-keymap (make-sparse-keymap "MULE") + "Keymap for MULE (Multilingual environment) specific commands.") + +;; Keep "C-x C-m ..." for mule specific commands. +(define-key ctl-x-map "\C-m" mule-keymap) + +(define-key mule-keymap "f" 'set-buffer-file-coding-system) +(define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs +(define-key mule-keymap "t" 'set-terminal-coding-system) +(define-key mule-keymap "k" 'set-keyboard-coding-system) +(define-key mule-keymap "p" 'set-buffer-process-coding-system) +(define-key mule-keymap "\C-\\" 'select-input-method) +(define-key mule-keymap "c" 'universal-coding-system-argument) +;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs +(define-key mule-keymap "C" 'list-coding-system) ; XEmacs +(define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs +(define-key mule-keymap "l" 'set-language-environment) + +(define-key help-map "\C-L" 'describe-language-support) +(define-key help-map "L" 'describe-language-environment) +(define-key help-map "\C-\\" 'describe-input-method) +(define-key help-map "I" 'describe-input-method) +(define-key help-map "C" 'describe-coding-system) +(define-key help-map "h" 'view-hello-file) + +;; Menu for XEmacs were moved to menubar-items.el. + + +;; This should be a single character key binding because users use it +;; very frequently while editing multilingual text. Now we can use +;; only two such keys: "\C-\\" and "\C-^", but the latter is not +;; convenient because it requires shifting on most keyboards. An +;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' +;; but it won't be used that frequently. +(define-key global-map "\C-\\" 'toggle-input-method) + +(defun view-hello-file () + "Display the HELLO file which list up many languages and characters." + (interactive) + ;; We have to decode the file in any environment. + (let ((coding-system-for-read 'iso-2022-7)) + (find-file-read-only (expand-file-name "HELLO" data-directory)))) + +(defun universal-coding-system-argument () + "Execute an I/O command using the specified coding system." + (interactive) + (let* ((coding-system + (read-coding-system "Coding system for following command: ")) + (keyseq (read-key-sequence + (format "Command to execute with %s:" coding-system))) + (cmd (key-binding keyseq))) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (message "") + (call-interactively cmd)))) + +(defun set-default-coding-systems (coding-system) + "Set default value of various coding systems to CODING-SYSTEM. +The follwing coding systems are set: + o coding system of a newly created buffer + o default coding system for terminal output + o default coding system for keyboard input + o default coding system for subprocess I/O" + (check-coding-system coding-system) + ;;(setq-default buffer-file-coding-system coding-system) + (set-default-buffer-file-coding-system coding-system) + ;;(setq default-terminal-coding-system coding-system) + (setq terminal-coding-system coding-system) + ;;(setq default-keyboard-coding-system coding-system) + (setq keyboard-coding-system coding-system) + ;;(setq default-process-coding-system (cons coding-system coding-system)) + (add-hook 'comint-exec-hook + `(lambda () + (let ((proc (get-buffer-process (current-buffer)))) + (set-process-input-coding-system proc ',coding-system) + (set-process-output-coding-system proc ',coding-system))) + 'append) + (setq file-name-coding-system coding-system)) + +(defun prefer-coding-system (coding-system) + "Add CODING-SYSTEM at the front of the priority list for automatic detection. +This also sets the following coding systems to CODING-SYSTEM: + o coding system of a newly created buffer + o default coding system for terminal output + o default coding system for keyboard input + o default coding system for subprocess I/O" + (interactive "zPrefer coding system: ") + (if (not (and coding-system (coding-system-p coding-system))) + (error "Invalid coding system `%s'" coding-system)) + (let ((coding-category (coding-system-category coding-system)) + (parent (coding-system-parent coding-system))) + (if (not coding-category) + ;; CODING-SYSTEM is no-conversion or undecided. + (error "Can't prefer the coding system `%s'" coding-system)) + (set coding-category (or parent coding-system)) + (if (not (eq coding-category (car coding-category-list))) + ;; We must change the order. + (setq coding-category-list + (cons coding-category + (delq coding-category coding-category-list)))) + (if (and parent (interactive-p)) + (message "Highest priority is set to %s (parent of %s)" + parent coding-system)) + (set-default-coding-systems (or parent coding-system)))) + + +;;; Language support staffs. + +(defvar language-info-alist nil + "Alist of language names vs the corresponding information of various kind. +Each element looks like: + (LANGUAGE-NAME . ((KEY . INFO) ...)) +where LANGUAGE-NAME is a string, +KEY is a symbol denoting the kind of information, +INFO is any Lisp object which contains the actual information related +to KEY.") + +(defun get-language-info (language-name key) + "Return the information for LANGUAGE-NAME of the kind KEY. +KEY is a symbol denoting the kind of required information." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) + (if lang-slot + (cdr (assq key (cdr lang-slot)))))) + +(defun set-language-info (language-name key info) + "Set for LANGUAGE-NAME the information INFO under KEY. +KEY is a symbol denoting the kind of information. +INFO is any Lisp object which contains the actual information. + +Currently, the following KEYs are used by Emacs: + +charset: list of symbols whose values are charsets specific to the language. + +coding-system: list of coding systems specific to the language. + +tutorial: a tutorial file name written in the language. + +sample-text: one line short text containing characters of the language. + +documentation: t or a string describing how Emacs supports the language. + If a string is specified, it is shown before any other information + of the language by the command `describe-language-environment'. + +setup-function: a function to call for setting up environment + convenient for a user of the language. + +If KEY is documentation or setup-function, you can also specify +a cons cell as INFO, in which case, the car part should be +a normal value as INFO for KEY (as described above), +and the cdr part should be a symbol whose value is a menu keymap +in which an entry for the language is defined. But, only the car part +is actually set as the information. + +We will define more KEYs in the future. To avoid conflict, +if you want to use your own KEY values, make them start with `user-'." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (let (lang-slot key-slot) + (setq lang-slot (assoc language-name language-info-alist)) + (if (null lang-slot) ; If no slot for the language, add it. + (setq lang-slot (list language-name) + language-info-alist (cons lang-slot language-info-alist))) + (setq key-slot (assq key lang-slot)) + (if (null key-slot) ; If no slot for the key, add it. + (progn + (setq key-slot (list key)) + (setcdr lang-slot (cons key-slot (cdr lang-slot))))) + ;; Setup menu. + (cond ((eq key 'documentation) + ;; (define-key-after + ;; (if (consp info) + ;; (prog1 (symbol-value (cdr info)) + ;; (setq info (car info))) + ;; describe-language-environment-map) + ;; (vector (intern language-name)) + ;; (cons language-name 'describe-specified-language-support) + ;; t) + (if (consp info) + (setq info (car info))) + (when (featurep 'menubar) + (eval-after-load + "menubar-items.elc" + `(add-menu-button + '("Mule" "Describe Language Support") + (vector ,language-name + '(describe-language-environment ,language-name) + t)))) + ) + ((eq key 'setup-function) + ;; (define-key-after + ;; (if (consp info) + ;; (prog1 (symbol-value (cdr info)) + ;; (setq info (car info))) + ;; setup-language-environment-map) + ;; (vector (intern language-name)) + ;; (cons language-name 'setup-specified-language-environment) + ;; t) + (if (consp info) + (setq info (car info))) + (when (featurep 'menubar) + (eval-after-load + "menubar-items.elc" + `(add-menu-button + '("Mule" "Set Language Environment") + (vector ,language-name + '(set-language-environment ,language-name) + t)))) + )) + + (setcdr key-slot info) + )) + +(defun set-language-info-alist (language-name alist) + "Set for LANGUAGE-NAME the information in ALIST. +ALIST is an alist of KEY and INFO. See the documentation of +`set-language-info' for the meanings of KEY and INFO." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (while alist + (set-language-info language-name (car (car alist)) (cdr (car alist))) + (setq alist (cdr alist)))) + +(defun read-language-name (key prompt &optional default) + "Read language name which has information for KEY, prompting with PROMPT. +DEFAULT is the default choice of language. +This returns a language name as a string." + (let* ((completion-ignore-case t) + (name (completing-read prompt + language-info-alist + (function (lambda (elm) (assq key elm))) + t nil default))) + (if (and (> (length name) 0) + (get-language-info name key)) + name))) + +;;; Multilingual input methods. + +(defconst leim-list-file-name "leim-list.el" + "Name of LEIM list file. +This file contains a list of libraries of Emacs input methods (LEIM) +in the format of Lisp expression for registering each input method. +Emacs loads this file at startup time.") + +(defvar leim-list-header (format +";;; %s -- list of LEIM (Library of Emacs Input Method) +;; +;; This file contains a list of LEIM (Library of Emacs Input Method) +;; in the same directory as this file. Loading this file registeres +;; the whole input methods in Emacs. +;; +;; Each entry has the form: +;; (register-input-method +;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC +;; TITLE DESCRIPTION +;; ARG ...) +;; See the function `register-input-method' for the meanings of arguments. +;; +;; If this directory is included in load-path, Emacs automatically +;; loads this file at startup time. + +" + leim-list-file-name) + "Header to be inserted in LEIM list file.") + +(defvar leim-list-entry-regexp "^(register-input-method" + "Regexp matching head of each entry in LEIM list file. +See also the variable `leim-list-header'") + +(defvar update-leim-list-functions + '(quail-update-leim-list-file) + "List of functions to call to update LEIM list file. +Each function is called with one arg, LEIM directory name.") + +(defun update-leim-list-file (&rest dirs) + "Update LEIM list file in directories DIRS." + (let ((functions update-leim-list-functions)) + (while functions + (apply (car functions) dirs) + (setq functions (cdr functions))))) + +(defvar current-input-method nil + "The current input method for multilingual text. +If nil, that means no input method is activated now.") +(make-variable-buffer-local 'current-input-method) +(put 'current-input-method 'permanent-local t) + +(defvar current-input-method-title nil + "Title string of the current input method shown in mode line.") +(make-variable-buffer-local 'current-input-method-title) +(put 'current-input-method-title 'permanent-local t) + +(defcustom default-input-method nil + "*Default input method for multilingual text. +This is the input method activated automatically by the command +`toggle-input-method' (\\[toggle-input-method])." + :group 'mule) + +(defvar input-method-history nil + "History list for some commands that read input methods.") +(make-variable-buffer-local 'input-method-history) +(put 'input-method-history 'permanent-local t) + +(defvar inactivate-current-input-method-function nil + "Function to call for inactivating the current input method. +Every input method should set this to an appropriate value when activated. +This function is called with no argument. + +This function should never change the value of `current-input-method'. +It is set to nil by the function `inactivate-input-method'.") +(make-variable-buffer-local 'inactivate-current-input-method-function) +(put 'inactivate-current-input-method-function 'permanent-local t) + +(defvar describe-current-input-method-function nil + "Function to call for describing the current input method. +This function is called with no argument.") +(make-variable-buffer-local 'describe-current-input-method-function) +(put 'describe-current-input-method-function 'permanent-local t) + +(defvar input-method-alist nil + "Alist of input method names vs the corresponding information to use it. +Each element has the form: + (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) +See the function `register-input-method' for the meanings of each elements.") + +(defun register-input-method (input-method language-name &rest args) + "Register INPUT-METHOD as an input method for LANGUAGE-NAME. +INPUT-METHOD and LANGUAGE-NAME are symbols or strings. +The remaining arguments are: + ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... + where, +ACTIVATE-FUNC is a function to call for activating this method. +TITLE is a string shown in mode-line while this method is active, +DESCRIPTION is a string describing about this method, +Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (if (symbolp input-method) + (setq input-method (symbol-name input-method))) + (let ((info (cons language-name args)) + (slot (assoc input-method input-method-alist))) + (if slot + (setcdr slot info) + (setq slot (cons input-method info)) + (setq input-method-alist (cons slot input-method-alist))))) + +(defun read-input-method-name (prompt &optional default inhibit-null) + "Read a name of input method from a minibuffer prompting with PROMPT. +If DEFAULT is non-nil, use that as the default, + and substitute it into PROMPT at the first `%s'. +If INHIBIT-NULL is non-nil, null input signals an error. + +The return value is a string." + (if default + (setq prompt (format prompt default))) + (let* ((completion-ignore-case t) + ;; This binding is necessary because input-method-history is + ;; buffer local. + (input-method (completing-read prompt input-method-alist + nil t nil 'input-method-history) + ;;default) + )) + (if (> (length input-method) 0) + input-method + (if inhibit-null + (error "No valid input method is specified"))))) + +(defun activate-input-method (input-method) + "Turn INPUT-METHOD on. +If some input method is already on, turn it off at first." + (if (symbolp input-method) + (setq input-method (symbol-name input-method))) + (if (and current-input-method + (not (string= current-input-method input-method))) + (inactivate-input-method)) + (unless current-input-method + (let ((slot (assoc input-method input-method-alist))) + (if (null slot) + (error "Can't activate input method `%s'" input-method)) + (apply (nth 2 slot) input-method (nthcdr 5 slot)) + (setq current-input-method input-method) + (setq current-input-method-title (nth 3 slot)) + (run-hooks 'input-method-activate-hook)))) + +(defun inactivate-input-method () + "Turn off the current input method." + (when current-input-method + (if input-method-history + (unless (string= current-input-method (car input-method-history)) + (setq input-method-history + (cons current-input-method + (delete current-input-method input-method-history)))) + (setq input-method-history (list current-input-method))) + (unwind-protect + (funcall inactivate-current-input-method-function) + (unwind-protect + (run-hooks 'input-method-inactivate-hook) + (setq current-input-method nil + current-input-method-title nil))))) + +(defun select-input-method (input-method) + "Select and turn on INPUT-METHOD. +This sets the default input method to what you specify, +and turn it on for the current buffer." + (interactive + (let* ((default (or (car input-method-history) default-input-method))) + (list (read-input-method-name + (if default "Select input method (default %s): " "Select input method: ") + default t)))) + (activate-input-method input-method) + (setq default-input-method input-method)) + +(defun toggle-input-method (&optional arg) + "Turn on or off a multilingual text input method for the current buffer. + +With arg, read an input method from minibuffer and turn it on. + +Without arg, if some input method is currently activated, turn it off, +else turn on an input method selected last time +or the default input method (see `default-input-method'). + +When there's no input method to turn on, turn on what read from minibuffer." + (interactive "P") + (let* ((default (or (car input-method-history) default-input-method))) + (if (and current-input-method (not arg)) + (inactivate-input-method) + (activate-input-method + (if (or arg (not default)) + (read-input-method-name + (if default "Input method (default %s): " "Input method: " ) + default t) + default)) + (or default-input-method + (setq default-input-method current-input-method))))) + +(defun describe-input-method (input-method) + "Describe input method INPUT-METHOD." + (interactive + (list (read-input-method-name + "Describe input method (default, current choice): "))) + (if (and input-method (symbolp input-method)) + (setq input-method (symbol-name input-method))) + (if (null input-method) + (describe-current-input-method) + (with-output-to-temp-buffer "*Help*" + (let ((elt (assoc input-method input-method-alist))) + (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" + input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) + +(defun describe-current-input-method () + "Describe the input method currently in use." + (if current-input-method + (if (and (symbolp describe-current-input-method-function) + (fboundp describe-current-input-method-function)) + (funcall describe-current-input-method-function) + (message "No way to describe the current input method `%s'" + (cdr current-input-method)) + (ding)) + (error "No input method is activated now"))) + +(defun read-multilingual-string (prompt &optional initial-input + input-method) + "Read a multilingual string from minibuffer, prompting with string PROMPT. +The input method selected last time is activated in minibuffer. +If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer +initially. +Optional 3rd argument INPUT-METHOD specifies the input method +to be activated instead of the one selected last time. It is a symbol +or a string." + (setq input-method + (or input-method + default-input-method + (read-input-method-name "Input method: " nil t))) + (if (and input-method (symbolp input-method)) + (setq input-method (symbol-name input-method))) + (let ((current-input-method input-method)) + ;; FSFmacs + ;; (read-string prompt initial-input nil nil t))) + (read-string prompt initial-input nil))) + +;; Variables to control behavior of input methods. All input methods +;; should react to these variables. + +(defcustom input-method-verbose-flag t + "*If this flag is non-nil, input methods give extra guidance. + +The extra guidance is done by showing list of available keys in echo +area. + +For complex input methods such as `chinese-py' and `japanese', +when you use the input method in the minibuffer, the guidance is +shown at the bottom short window (split from the existing window). +For simple input methods, guidance is not shown +when you are in the minibuffer." + :type 'boolean + :group 'mule) + +(defcustom input-method-highlight-flag t + "*If this flag is non-nil, input methods highlight partially-entered text. +For instance, while you are in the middle of a Quail input method sequence, +the text inserted so far is temporarily underlined. +The underlining goes away when you finish or abort the input method sequence." + :type 'boolean + :group 'mule) + +(defvar input-method-activate-hook nil + "Normal hook run just after an input method is activated. + +The variable `current-input-method' keeps the input method name +just activated.") + +(defvar input-method-inactivate-hook nil + "Normal hook run just after an input method is inactivated. + +The variable `current-input-method' still keeps the input method name +just inacitvated.") + +(defvar input-method-after-insert-chunk-hook nil + "Normal hook run just after an input method insert some chunk of text.") + +(defvar input-method-exit-on-invalid-key nil + "This flag controls the behaviour of an input method on invalid key input. +Usually, when a user types a key which doesn't start any character +handled by the input method, the key is handled by turning off the +input method temporalily. After the key is handled, the input method is +back on. +But, if this flag is non-nil, the input method is never back on.") + + +(defun setup-specified-language-environment () + "Set up multi-lingual environment convenient for the specified language." + (interactive) + (let (language-name) + (if (and (symbolp last-command-event) + (or (not (eq last-command-event 'Default)) + (setq last-command-event 'English)) + (setq language-name (symbol-name last-command-event))) + (set-language-environment language-name) + (error "Bogus calling sequence")))) + +(defvar current-language-environment "English" + "The last language environment specified with `set-language-environment'.") + +(defun set-language-environment (language-name) + "Set up multi-lingual environment for using LANGUAGE-NAME. +This sets the coding system priority and the default input method +and sometimes other things." + (interactive (list (read-language-name 'setup-function + "Set language environment: "))) + (if language-name + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (setq language-name "English")) + (if (null (get-language-info language-name 'setup-function)) + (error "Language environment not defined: %S" language-name)) + (funcall (get-language-info language-name 'setup-function)) + (setq current-language-environment language-name) + (force-mode-line-update t)) + +;; Print all arguments with `princ', then print "\n". +(defsubst princ-list (&rest args) + (while args (princ (car args)) (setq args (cdr args))) + (princ "\n")) + +;; Print a language specific information such as input methods, +;; charsets, and coding systems. This function is intended to be +;; called from the menu: +;; [menu-bar mule describe-language-environment LANGUAGE] +;; and should not run it by `M-x describe-current-input-method-function'. +(defun describe-specified-language-support () + "Describe how Emacs supports the specified language environment." + (interactive) + (let (language-name) + (if (not (and (symbolp last-command-event) + (setq language-name (symbol-name last-command-event)))) + (error "Bogus calling sequence")) + (describe-language-environment language-name))) + +(defun describe-language-environment (language-name) + "Describe how Emacs supports language environment LANGUAGE-NAME." + (interactive + (list (read-language-name + 'documentation + "Describe language environment (default, current choise): "))) + (if (null language-name) + (setq language-name current-language-environment)) + (if (or (null language-name) + (null (get-language-info language-name 'documentation))) + (error "No documentation for the specified language")) + (if (symbolp language-name) + (setq language-name (symbol-name language-name))) + (let ((doc (get-language-info language-name 'documentation))) + (with-output-to-temp-buffer "*Help*" + (if (stringp doc) + (progn + (princ-list doc) + (terpri))) + (let ((str (get-language-info language-name 'sample-text))) + (if (stringp str) + (progn + (princ "Sample text:\n") + (princ-list " " str) + (terpri)))) + (princ "Input methods:\n") + (let ((l input-method-alist)) + (while l + (if (string= language-name (nth 1 (car l))) + (princ-list " " (car (car l)) + (format " (`%s' in mode line)" (nth 3 (car l))))) + (setq l (cdr l)))) + (terpri) + (princ "Character sets:\n") + (let ((l (get-language-info language-name 'charset))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ-list " " (car l) ": " + (charset-description (car l))) + (setq l (cdr l))))) + (terpri) + (princ "Coding systems:\n") + (let ((l (get-language-info language-name 'coding-system))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ ; (format " %s (`%c' in mode line):\n\t%s\n" + ;; In XEmacs, `coding-system-mnemonic' returns string. + (format " %s (`%s' in mode line):\n\t%s\n" + (car l) + (coding-system-mnemonic (car l)) + (coding-system-doc-string (car l)))) + (setq l (cdr l)))))))) + +;;; Charset property + +;; (defsubst get-charset-property (charset propname) +;; "Return the value of CHARSET's PROPNAME property. +;; This is the last value stored with +;; `(put-charset-property CHARSET PROPNAME VALUE)'." +;; (plist-get (charset-plist charset) propname)) + +;; (defsubst put-charset-property (charset propname value) +;; "Store CHARSETS's PROPNAME property with value VALUE. +;; It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." +;; (set-charset-plist charset +;; (plist-put (charset-plist charset) propname value))) + +(defvar char-code-property-table + (make-char-table 'generic) + "Char-table containing a property list of each character code. +;; +See also the documentation of `get-char-code-property' and +`put-char-code-property'") +;; (let ((plist (aref char-code-property-table char))) +(defun get-char-code-property (char propname) + "Return the value of CHAR's PROPNAME property in `char-code-property-table'." + (let ((plist (get-char-table char char-code-property-table))) + (if (listp plist) + (car (cdr (memq propname plist)))))) + +(defun put-char-code-property (char propname value) + "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. +It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." + (let ((plist (get-char-table char char-code-property-table))) + (if plist + (let ((slot (memq propname plist))) + (if slot + (setcar (cdr slot) value) + (nconc plist (list propname value)))) + (put-char-table char (list propname value) char-code-property-table) + ))) +;; (setcar (cdr slot) value) +;; (nconc plist (list propname value)))) +;; (aset char-code-property-table char (list propname value))))) + +;;; mule-cmds.el ends here diff --git a/lisp/mule/mule-coding.el b/lisp/mule/mule-coding.el new file mode 100644 index 0000000..3880c18 --- /dev/null +++ b/lisp/mule/mule-coding.el @@ -0,0 +1,188 @@ +;;; mule-coding.el --- Coding-system functions for Mule. + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; 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. + +;;; Commentary: + +;;; split off of mule.el and mostly moved to coding.el + +;;; Code: + +(defun coding-system-force-on-output (coding-system register) + "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER." + (unless (integerp register) + (signal 'wrong-type-argument (list 'integerp register))) + (coding-system-property + coding-system + (case register + (0 'force-g0-on-output) + (1 'force-g1-on-output) + (2 'force-g2-on-output) + (3 'force-g3-on-output) + (t (signal 'args-out-of-range (list register 0 3)))))) + +(defun coding-system-short (coding-system) + "Return the 'short property of CODING-SYSTEM." + (coding-system-property coding-system 'short)) + +(defun coding-system-no-ascii-eol (coding-system) + "Return the 'no-ascii-eol property of CODING-SYSTEM." + (coding-system-property coding-system 'no-ascii-eol)) + +(defun coding-system-no-ascii-cntl (coding-system) + "Return the 'no-ascii-cntl property of CODING-SYSTEM." + (coding-system-property coding-system 'no-ascii-cntl)) + +(defun coding-system-seven (coding-system) + "Return the 'seven property of CODING-SYSTEM." + (coding-system-property coding-system 'seven)) + +(defun coding-system-lock-shift (coding-system) + "Return the 'lock-shift property of CODING-SYSTEM." + (coding-system-property coding-system 'lock-shift)) + +;;(defun coding-system-use-japanese-jisx0201-roman (coding-system) +;; "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM." +;; (coding-system-property coding-system 'use-japanese-jisx0201-roman)) + +;;(defun coding-system-use-japanese-jisx0208-1978 (coding-system) +;; "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM." +;; (coding-system-property coding-system 'use-japanese-jisx0208-2978)) + +(defun coding-system-no-iso6429 (coding-system) + "Return the 'no-iso6429 property of CODING-SYSTEM." + (coding-system-property coding-system 'no-iso6429)) + +(defun coding-system-ccl-encode (coding-system) + "Return the CCL 'encode property of CODING-SYSTEM." + (coding-system-property coding-system 'encode)) + +(defun coding-system-ccl-decode (coding-system) + "Return the CCL 'decode property of CODING-SYSTEM." + (coding-system-property coding-system 'decode)) + + +;;;; Definitions of predefined coding systems + +(make-coding-system + 'ctext 'iso2022 + "Coding-system used in X as Compound Text Encoding." + '(charset-g0 ascii + charset-g1 latin-iso8859-1 + eol-type nil + mnemonic "CText")) + +;;; iso-8859-1 and ctext are aliases. + +;; (copy-coding-system 'ctext 'iso-8859-1) +(make-coding-system + 'iso-8859-1 'no-conversion + "Coding-system used in X as Compound Text Encoding." + '(eol-type nil mnemonic "Noconv")) + +(make-coding-system + 'iso-2022-8bit-ss2 'iso2022 + "ISO-2022 coding system using SS2 for 96-charset in 8-bit code." + '(charset-g0 ascii + charset-g1 latin-iso8859-1 + charset-g2 t ;; unspecified but can be used later. + short t + mnemonic "ISO8/SS" + )) + +(make-coding-system + 'iso-2022-7bit-ss2 'iso2022 + "ISO-2022 coding system using SS2 for 96-charset in 7-bit code." + '(charset-g0 ascii + charset-g2 t ;; unspecified but can be used later. + seven t + short t + mnemonic "ISO7/SS" + eol-type nil)) + +;; (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2) +(make-coding-system + 'iso-2022-jp-2 'iso2022 + "ISO-2022 coding system using SS2 for 96-charset in 7-bit code." + '(charset-g0 ascii + charset-g2 t ;; unspecified but can be used later. + seven t + short t + mnemonic "ISO7/SS" + eol-type nil)) + +(make-coding-system + 'iso-2022-7bit 'iso2022 + "ISO 2022 based 7-bit encoding using only G0" + '(charset-g0 ascii + seven t + short t + mnemonic "ISO7")) + +;; compatibility for old XEmacsen +(copy-coding-system 'iso-2022-7bit 'iso-2022-7) + +(make-coding-system + 'iso-2022-8 'iso2022 + "ISO-2022 eight-bit coding system. No single-shift or locking-shift." + '(charset-g0 ascii + charset-g1 latin-iso8859-1 + short t + mnemonic "ISO8" + )) + +(make-coding-system + 'escape-quoted 'iso2022 + "ISO-2022 eight-bit coding system with escape quoting; used for .ELC files." + '(charset-g0 ascii + charset-g1 latin-iso8859-1 + eol-type lf + escape-quoted t + mnemonic "ESC/Quot" + )) + +(make-coding-system + 'iso-2022-lock 'iso2022 + "ISO-2022 coding system using Locking-Shift for 96-charset." + '(charset-g0 ascii + charset-g1 t ;; unspecified but can be used later. + seven t + lock-shift t + mnemonic "ISO7/Lock" + )) + +;; initialize the coding categories to something semi-reasonable +;; so that the remaining Lisp files can contain extended characters. +;; (They will be in ISO-7 format) + +(set-coding-priority-list '(iso-8-2 iso-8-designate iso-8-1 + iso-7 iso-lock-shift no-conversion)) + +(set-coding-category-system 'iso-7 'iso-2022-7) +(set-coding-category-system 'iso-8-designate 'ctext) +(set-coding-category-system 'iso-8-1 'ctext) +(set-coding-category-system 'iso-lock-shift 'iso-2022-lock) +(set-coding-category-system 'no-conversion 'no-conversion) + +;;; mule-coding.el ends here diff --git a/lisp/mule/mule-files.el b/lisp/mule/mule-files.el new file mode 100644 index 0000000..e228426 --- /dev/null +++ b/lisp/mule/mule-files.el @@ -0,0 +1,35 @@ +;;; mule-files.el --- File I/O functions for XEmacs/Mule. + +;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. + +;; 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. + +;;; Commentary: + +;;; Derived from mule.el in the original Mule but heavily modified +;;; by Ben Wing. Mostly moved to code-files.el + +;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API. + +;;; Code: + +(setq-default buffer-file-coding-system 'iso-2022-8) + +;;; mule-files.el ends here diff --git a/lisp/mule/viet-chars.el b/lisp/mule/viet-chars.el new file mode 100644 index 0000000..0df00f9 --- /dev/null +++ b/lisp/mule/viet-chars.el @@ -0,0 +1,57 @@ +;;; vietnamese-chars.el --- pre-loaded support for Vietnamese, part 1. + +;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. + +;; 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. + +;;; Synched up with: Mule 2.3. + +;; We have to split up the Vietnamese stuff into two files because +;; we are registering new charsets and then immediately using characters +;; from those sets. We cannot reliably expect this to work if they +;; are in the same file because of the buffering that happens while +;; reading -- the place where we use the newly-defined sets may be +;; read in before the code that creates those sets is evaluated. + +;; Vietnamese VISCII with two tables. +(make-charset 'vietnamese-viscii-lower "VISCII lower (Vietnamese)" + '(registry "VISCII1.1" + dimension 1 + chars 96 + final ?1 + graphic 1 + )) + +(make-charset 'vietnamese-viscii-upper "VISCII upper (Vietnamese)" + '(registry "VISCII1.1" + dimension 1 + chars 96 + final ?2 + graphic 1 + )) + +(modify-syntax-entry 'vietnamese-viscii-lower "w") +(modify-syntax-entry 'vietnamese-viscii-upper "w") + +(define-category ?v "Vietnamese character.") +(modify-category-entry 'vietnamese-viscii-lower ?v) +(modify-category-entry 'vietnamese-viscii-upper ?v) + +;;; vietnamese-chars.el ends here -- 1.7.10.4