--- /dev/null
+;;; 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*)))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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 (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B) \e$ADc:C\e(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 (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(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
--- /dev/null
+;;; 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 '(?\e$B!<\e(B ?\e$B!+\e(B ?\e$B!,\e(B ?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(B)
+ do (modify-syntax-entry char "w"))
+(modify-syntax-entry ?\\e$B!J\e(B "(\e$B!K\e(B")
+(modify-syntax-entry ?\\e$B!N\e(B "(\e$B!O\e(B")
+(modify-syntax-entry ?\\e$B!P\e(B "(\e$B!Q\e(B")
+(modify-syntax-entry ?\\e$B!V\e(B "(\e$B!W\e(B")
+(modify-syntax-entry ?\\e$B!X\e(B "(\e$B!Y\e(B")
+(modify-syntax-entry ?\\e$B!K\e(B ")\e$B!J\e(B")
+(modify-syntax-entry ?\\e$B!O\e(B ")\e$B!N\e(B")
+(modify-syntax-entry ?\\e$B!Q\e(B ")\e$B!P\e(B")
+(modify-syntax-entry ?\\e$B!W\e(B ")\e$B!V\e(B")
+(modify-syntax-entry ?\\e$B!Y\e(B ")\e$B!X\e(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 '(?\e$B!<\e(B ?\e$B!+\e(B ?\e$B!,\e(B)
+ do (modify-category-entry char ?K)
+ (modify-category-entry char ?H))
+(loop for char in '(?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(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
+ "\\("
+ "\\("
+ "[.?!][]\"')}]*"
+ "\\|"
+ "[\e$B!%!)!*\e(B][\e$B!O!I!G!K!Q!M!S!U!W!Y\e(B]*"
+ "\\)"
+ "\\($\\|\t\\| \\)"
+ "\\|"
+ "\e$B!#\e(B"
+ "\\)"
+ "[ \t\n]*"))
+(setq paragraph-start "^[ \e$B!!\e(B\t\n\f]")
+(setq paragraph-separate "^[ \e$B!!\e(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
+ "\e$B!"\e(B" aletter "\\|"
+ "\e$B!#\e(B" aletter "\\|"
+ aletter "\e$B!J\e(B" "\\|"
+ "\e$B!K\e(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")
+\f
+;; (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 (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e(I:]FAJ\e(B")
+ (documentation . t)))
+
+;;; japanese.el ends here
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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 <wing@666.com>. The initialization code
+;; at the end of this file comes from Mule.
+;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
+
+;;; 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 "\e$B!!\e(B")
+(defvar kanji-symbols "\\cS")
+(defvar kanji-numeric "[\e$B#0\e(B-\e$B#9\e(B]")
+(defvar kanji-English-Upper "[\e$B#A\e(B-\e$B#Z\e(B]")
+(defvar kanji-English-Lower "[\e$B#a\e(B-\e$B#z\e(B]")
+(defvar kanji-hiragana "\\cH")
+(defvar kanji-katakana "\\cK")
+(defvar kanji-Greek-Upper "[\e$B&!\e(B-\e$B&8\e(B]")
+(defvar kanji-Greek-Lower "[\e$B&A\e(B-\e$B&X\e(B]")
+(defvar kanji-Russian-Upper "[\e$B'!\e(B-\e$B'A\e(B]")
+(defvar kanji-Russian-Lower "[\e$B'Q\e(B-\e$B'q\e(B]")
+(defvar kanji-Kanji-1st-Level "[\e$B0!\e(B-\e$BOS\e(B]")
+(defvar kanji-Kanji-2nd-Level "[\e$BP!\e(B-\e$Bt$\e(B]")
+
+(defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)")
--- /dev/null
+;;; 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.
+
+\f
+;;;; 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))))))))))
+
+\f
+;;;; 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))
+
+\f
+;;;; 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)
--- /dev/null
+;;; 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))))
+
+\f
+;;; 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)))
+\f
+;;; 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.")
+
+\f
+(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))))))))
+\f
+;;; 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
--- /dev/null
+;;; 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))
+
+\f
+;;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
projects / chise / xemacs-chise.git.1 / commitdiff