alexey, please check out the attached lisp file, which is from fsf emacs.
it includes case translations for cyrillic, among other things.
please try loading the whole file and see if you run into problems; if not, or
if you can fix up the problems, i'll include the file in xemacs.
Alexey Mahotkin wrote:
Hello,
I've noticed that when I enter some Russian text and try to upper-case
it, it does not get changed...
I've setup language environment with
(set-language-environment 'Cyrillic-KOI8)
Do I need to add something more to make it work? Could we somehow
make `set-language-environment' to setup case-table automatically?
As far as I know, FSF Emacs handles this ok.
Btw, what is the status of my Mule-related patches (to docs and to
cyrillic.el?)
Thanks,
--alexm
--
ben
I'm sometimes slow in getting around to reading my mail, so if you
want to reach me faster, call 520-661-6661.
See
http://www.666.com/ben/chronic-pain/ for the hell I've been
through.
;;; characters.el --- set syntax and category for multibyte characters
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Keywords: multibyte character, character set, syntax, category
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This file contains multibyte characters. Save this file always in
;; the coding system `iso-2022-7bit'.
;; This file does not define the syntax for Latin-N character sets;
;; those are defined by the files latin-N.el.
;;; Predefined categories.
;; For each character set.
(define-category ?a "ASCII")
(define-category ?l "Latin")
(define-category ?t "Thai")
(define-category ?g "Greek")
(define-category ?b "Arabic")
(define-category ?w "Hebrew")
(define-category ?y "Cyrillic")
(define-category ?k "Japanese katakana")
(define-category ?r "Japanese roman")
(define-category ?c "Chinese")
(define-category ?j "Japanese")
(define-category ?h "Korean")
(define-category ?e "Ethiopic (Ge'ez)")
(define-category ?v "Vietnamese")
(define-category ?i "Indian")
(define-category ?o "Lao")
(define-category ?q "Tibetan")
;; For each group (row) of 2-byte character sets.
(define-category ?A "Alpha-numeric characters of 2-byte character sets")
(define-category ?C "Chinese (Han) characters of 2-byte character sets")
(define-category ?G "Greek characters of 2-byte character sets")
(define-category ?H "Japanese Hiragana characters of 2-byte character sets")
(define-category ?K "Japanese Katakana characters of 2-byte character sets")
(define-category ?N "Korean Hangul characters of 2-byte character sets")
(define-category ?Y "Cyrillic characters of 2-byte character sets")
(define-category ?I "Indian Glyphs")
;; For phonetic classifications.
(define-category ?0 "consonant")
(define-category ?1 "base (independent) vowel")
(define-category ?2 "upper diacritical mark (including upper vowel)")
(define-category ?3 "lower diacritical mark (including lower vowel)")
(define-category ?4 "tone mark")
(define-category ?5 "symbol")
(define-category ?6 "digit")
(define-category ?7 "vowel-modifying diacritical mark")
(define-category ?8 "vowel-signs")
(define-category ?9 "semivowel lower")
;; For filling.
(define-category ?| "While filling, we can break a line at this character.")
;; For indentation calculation.
(define-category ?
"This character counts as a space for indentation purposes.")
;; Keep the following for `kinsoku' processing. See comments in
;; kinsoku.el.
(define-category ?> "A character which can't be placed at beginning of
line.")
(define-category ?< "A character which can't be placed at end of line.")
;;; Setting syntax and category.
;; ASCII
(let ((ch 32))
(while (< ch 127) ; All ASCII characters have
(modify-category-entry ch ?a) ; the category `a' (ASCII)
(modify-category-entry ch ?l) ; and `l' (Latin).
(setq ch (1+ ch))))
;; Arabic character set
(let ((charsets '(arabic-iso8859-6
arabic-digit
arabic-1-column
arabic-2-column)))
(while charsets
(modify-syntax-entry (make-char (car charsets)) "w")
(modify-category-entry (make-char (car charsets)) ?b)
(setq charsets (cdr charsets))))
;; Chinese character set (GB2312)
(modify-syntax-entry (make-char 'chinese-gb2312) "w")
(modify-syntax-entry (make-char 'chinese-gb2312 33) "_")
(modify-syntax-entry (make-char 'chinese-gb2312 34) "_")
(modify-syntax-entry (make-char 'chinese-gb2312 41) "_")
(modify-syntax-entry ?\$A!2(B "($A!3(B")
(modify-syntax-entry ?\$A!4(B "($A!5(B")
(modify-syntax-entry ?\$A!6(B "($A!7(B")
(modify-syntax-entry ?\$A!8(B "($A!9(B")
(modify-syntax-entry ?\$A!:(B "($A!;(B")
(modify-syntax-entry ?\$A!<(B "($A!=(B")
(modify-syntax-entry ?\$A!>(B "($A!?(B")
(modify-syntax-entry ?\$A!3(B ")$A!2(B")
(modify-syntax-entry ?\$A!5(B ")$A!4(B")
(modify-syntax-entry ?\$A!7(B ")$A!6(B")
(modify-syntax-entry ?\$A!9(B ")$A!8(B")
(modify-syntax-entry ?\$A!;(B ")$A!:(B")
(modify-syntax-entry ?\$A!=(B ")$A!<(B")
(modify-syntax-entry ?\$A!?(B ")$A!>(B")
(modify-category-entry (make-char 'chinese-gb2312) ?c)
(modify-category-entry (make-char 'chinese-gb2312) ?\|)
(modify-category-entry (make-char 'chinese-gb2312 35) ?A)
(modify-category-entry (make-char 'chinese-gb2312 36) ?H)
(modify-category-entry (make-char 'chinese-gb2312 37) ?K)
(modify-category-entry (make-char 'chinese-gb2312 38) ?G)
(modify-category-entry (make-char 'chinese-gb2312 39) ?Y)
(let ((row 48))
(while (< row 127)
(modify-category-entry (make-char 'chinese-gb2312 row) ?C)
(setq row (1+ row))))
;; Chinese character set (BIG5)
(let ((generic-big5-1-char (make-char 'chinese-big5-1))
(generic-big5-2-char (make-char 'chinese-big5-2)))
(modify-syntax-entry generic-big5-1-char "w")
(modify-syntax-entry generic-big5-2-char "w")
(modify-category-entry generic-big5-1-char ?c)
(modify-category-entry generic-big5-2-char ?c)
(modify-category-entry generic-big5-1-char ?C)
(modify-category-entry generic-big5-2-char ?C)
(modify-category-entry generic-big5-1-char ?\|)
(modify-category-entry generic-big5-2-char ?\|))
;; Chinese character set (CNS11643)
(let ((cns-list '(chinese-cns11643-1
chinese-cns11643-2
chinese-cns11643-3
chinese-cns11643-4
chinese-cns11643-5
chinese-cns11643-6
chinese-cns11643-7))
generic-char)
(while cns-list
(setq generic-char (make-char (car cns-list)))
(modify-syntax-entry generic-char "w")
(modify-category-entry generic-char ?c)
(modify-category-entry generic-char ?C)
(modify-category-entry generic-char ?|)
(setq cns-list (cdr cns-list))))
;; Cyrillic character set (ISO-8859-5)
(modify-category-entry (make-char 'cyrillic-iso8859-5) ?y)
(modify-syntax-entry (make-char 'cyrillic-iso8859-5 160) " ")
(modify-syntax-entry ?,L-(B ".")
(modify-syntax-entry ?,Lp(B ".")
(modify-syntax-entry ?,L}(B ".")
(let ((tbl (standard-case-table)))
(set-case-syntax-pair ?,L!(B ?,Lq(B tbl)
(set-case-syntax-pair ?,L"(B ?,Lr(B tbl)
(set-case-syntax-pair ?,L#(B ?,Ls(B tbl)
(set-case-syntax-pair ?,L$(B ?,Lt(B tbl)
(set-case-syntax-pair ?,L%(B ?,Lu(B tbl)
(set-case-syntax-pair ?,L&(B ?,Lv(B tbl)
(set-case-syntax-pair ?,L'(B ?,Lw(B tbl)
(set-case-syntax-pair ?,L((B ?,Lx(B tbl)
(set-case-syntax-pair ?,L)(B ?,Ly(B tbl)
(set-case-syntax-pair ?,L*(B ?,Lz(B tbl)
(set-case-syntax-pair ?,L+(B ?,L{(B tbl)
(set-case-syntax-pair ?,L,(B ?,L|(B tbl)
(set-case-syntax-pair ?,L.(B ?,L~(B tbl)
(set-case-syntax-pair ?,L/(B ?,L(B tbl)
(set-case-syntax-pair ?,L0(B ?,LP(B tbl)
(set-case-syntax-pair ?,L1(B ?,LQ(B tbl)
(set-case-syntax-pair ?,L2(B ?,LR(B tbl)
(set-case-syntax-pair ?,L3(B ?,LS(B tbl)
(set-case-syntax-pair ?,L4(B ?,LT(B tbl)
(set-case-syntax-pair ?,L5(B ?,LU(B tbl)
(set-case-syntax-pair ?,L6(B ?,LV(B tbl)
(set-case-syntax-pair ?,L7(B ?,LW(B tbl)
(set-case-syntax-pair ?,L8(B ?,LX(B tbl)
(set-case-syntax-pair ?,L9(B ?,LY(B tbl)
(set-case-syntax-pair ?,L:(B ?,LZ(B tbl)
(set-case-syntax-pair ?,L;(B ?,L[(B tbl)
(set-case-syntax-pair ?,L<(B ?,L\(B tbl)
(set-case-syntax-pair ?,L=(B ?,L](B tbl)
(set-case-syntax-pair ?,L>(B ?,L^(B tbl)
(set-case-syntax-pair ?,L?(B ?,L_(B tbl)
(set-case-syntax-pair ?,L@(B ?,L`(B tbl)
(set-case-syntax-pair ?,LA(B ?,La(B tbl)
(set-case-syntax-pair ?,LB(B ?,Lb(B tbl)
(set-case-syntax-pair ?,LC(B ?,Lc(B tbl)
(set-case-syntax-pair ?,LD(B ?,Ld(B tbl)
(set-case-syntax-pair ?,LE(B ?,Le(B tbl)
(set-case-syntax-pair ?,LF(B ?,Lf(B tbl)
(set-case-syntax-pair ?,LG(B ?,Lg(B tbl)
(set-case-syntax-pair ?,LH(B ?,Lh(B tbl)
(set-case-syntax-pair ?,LI(B ?,Li(B tbl)
(set-case-syntax-pair ?,LJ(B ?,Lj(B tbl)
(set-case-syntax-pair ?,LK(B ?,Lk(B tbl)
(set-case-syntax-pair ?,LL(B ?,Ll(B tbl)
(set-case-syntax-pair ?,LM(B ?,Lm(B tbl)
(set-case-syntax-pair ?,LN(B ?,Ln(B tbl)
(set-case-syntax-pair ?,LO(B ?,Lo(B tbl))
;; Devanagari character set
(let ((deflist '(;; chars syntax category
("$(5!!!"!#(B" "w" ?7) ; vowel-modifying diacritical mark
; chandrabindu, anuswar, visarga
("$(5!$(B-$(5!2(B" "w" ?1) ; independent vowel
("$(5!3(B-$(5!X(B" "w" ?0) ; consonant
("$(5!Z(B-$(5!g(B" "w" ?8) ; matra
("$(5!q(B-$(5!z(B" "w" ?6) ; digit
))
elm chars len syntax category to ch i)
(while deflist
(setq elm (car deflist))
(setq chars (car elm)
len (length chars)
syntax (nth 1 elm)
category (nth 2 elm)
i 0)
(while (< i len)
(if (= (aref chars i) ?-)
(setq i (1+ i)
to (aref chars i))
(setq ch (aref chars i)
to ch))
(while (<= ch to)
(modify-syntax-entry ch syntax)
(modify-category-entry ch category)
(setq ch (1+ ch)))
(setq i (1+ i)))
(setq deflist (cdr deflist))))
;; Ethiopic character set
(modify-category-entry (make-char 'ethiopic) ?e)
(modify-syntax-entry (make-char 'ethiopic) "w")
(let ((chars '(?$(3$h(B ?$(3$i(B ?$(3$j(B ?$(3$k(B ?$(3$l(B ?$(3$m(B
?$(3$n(B ?$(3$o(B ?$(3%i(B ?$(3%t(B ?$(3%u(B ?$(3%v(B ?$(3%w(B
?$(3%x(B)))
(while chars
(modify-syntax-entry (car chars) ".")
(setq chars (cdr chars))))
;; Greek character set (ISO-8859-7)
(modify-category-entry (make-char 'greek-iso8859-7) ?g)
(let ((c 182))
(while (< c 255)
(modify-syntax-entry (make-char 'greek-iso8859-7 c) "w")
(setq c (1+ c))))
(modify-syntax-entry (make-char 'greek-iso8859-7 160) "w") ; NBSP
(modify-syntax-entry ?,F7(B ".")
(modify-syntax-entry ?,F;(B ".")
(modify-syntax-entry ?,F=(B ".")
(let ((tbl (standard-case-table)))
(set-case-syntax-pair ?,FA(B ?,Fa(B tbl)
(set-case-syntax-pair ?,FB(B ?,Fb(B tbl)
(set-case-syntax-pair ?,FC(B ?,Fc(B tbl)
(set-case-syntax-pair ?,FD(B ?,Fd(B tbl)
(set-case-syntax-pair ?,FE(B ?,Fe(B tbl)
(set-case-syntax-pair ?,FF(B ?,Ff(B tbl)
(set-case-syntax-pair ?,FG(B ?,Fg(B tbl)
(set-case-syntax-pair ?,FH(B ?,Fh(B tbl)
(set-case-syntax-pair ?,FI(B ?,Fi(B tbl)
(set-case-syntax-pair ?,FJ(B ?,Fj(B tbl)
(set-case-syntax-pair ?,FK(B ?,Fk(B tbl)
(set-case-syntax-pair ?,FL(B ?,Fl(B tbl)
(set-case-syntax-pair ?,FM(B ?,Fm(B tbl)
(set-case-syntax-pair ?,FN(B ?,Fn(B tbl)
(set-case-syntax-pair ?,FO(B ?,Fo(B tbl)
(set-case-syntax-pair ?,FP(B ?,Fp(B tbl)
(set-case-syntax-pair ?,FQ(B ?,Fq(B tbl)
(set-case-syntax-pair ?,FS(B ?,Fs(B tbl)
(set-case-syntax-pair ?,FT(B ?,Ft(B tbl)
(set-case-syntax-pair ?,FU(B ?,Fu(B tbl)
(set-case-syntax-pair ?,FV(B ?,Fv(B tbl)
(set-case-syntax-pair ?,FW(B ?,Fw(B tbl)
(set-case-syntax-pair ?,FX(B ?,Fx(B tbl)
(set-case-syntax-pair ?,FY(B ?,Fy(B tbl)
(set-case-syntax-pair ?,FZ(B ?,Fz(B tbl)
(set-case-syntax-pair ?,F[(B ?,F{(B tbl)
(set-case-syntax-pair ?,F?(B ?,F~(B tbl)
(set-case-syntax-pair ?,F>(B ?,F}(B tbl)
(set-case-syntax-pair ?,F<(B ?,F|(B tbl)
(set-case-syntax-pair ?,F6(B ?,F\(B tbl)
(set-case-syntax-pair ?,F8(B ?,F](B tbl)
(set-case-syntax-pair ?,F9(B ?,F^(B tbl)
(set-case-syntax-pair ?,F:(B ?,F_(B tbl))
;; Hebrew character set (ISO-8859-8)
(modify-category-entry (make-char 'hebrew-iso8859-8) ?w)
(let ((c 224))
(while (< c 251)
(modify-syntax-entry (make-char 'hebrew-iso8859-8 c) "w")
(setq c (1+ c))))
(modify-syntax-entry (make-char 'hebrew-iso8859-8 160) "w") ; NBSP
;; Indian character set (IS 13194 and other Emacs original Indian charsets)
(modify-category-entry (make-char 'indian-is13194) ?i)
(modify-category-entry (make-char 'indian-2-column) ?I)
(modify-category-entry (make-char 'indian-1-column) ?I)
(let ((deflist
'(;; chars syntax category
("(5!"#(B" "w" ?7) ; vowel-modifying diacritical mark
; chandrabindu, anuswar, visarga
("(5$(B-(52(B" "w" ?1) ; base (independent) vowel
("(53(B-(5X(B" "w" ?0) ; consonant
("(5Z(B-(5g(B" "w" ?8) ; matra
("(5q(B-(5z(B" "w" ?6) ; digit
))
elm chars len syntax category to ch i)
(while deflist
(setq elm (car deflist))
(setq chars (car elm)
len (length chars)
syntax (nth 1 elm)
category (nth 2 elm)
i 0)
(while (< i len)
(if (= (aref chars i) ?-)
(setq i (1+ i)
to (aref chars i))
(setq ch (aref chars i)
to ch))
(while (<= ch to)
(modify-syntax-entry ch syntax)
(modify-category-entry ch category)
(setq ch (1+ ch)))
(setq i (1+ i)))
(setq deflist (cdr deflist))))
;; Japanese character set (JISX0201-kana, JISX0201-roman, JISX0208, JISX0212)
(modify-category-entry (make-char 'katakana-jisx0201) ?k)
(modify-category-entry (make-char 'katakana-jisx0201) ?j)
(modify-category-entry (make-char 'latin-jisx0201) ?r)
(modify-category-entry (make-char 'japanese-jisx0208) ?j)
(modify-category-entry (make-char 'japanese-jisx0212) ?j)
(modify-category-entry (make-char 'katakana-jisx0201) ?\|)
(modify-category-entry (make-char 'japanese-jisx0208) ?\|)
(modify-category-entry (make-char 'japanese-jisx0212) ?\|)
;; JISX0208
(modify-syntax-entry (make-char 'japanese-jisx0208) "w")
(modify-syntax-entry (make-char 'japanese-jisx0208 33) "_")
(modify-syntax-entry (make-char 'japanese-jisx0208 34) "_")
(modify-syntax-entry (make-char 'japanese-jisx0208 40) "_")
(let ((chars '(?$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)))
(while chars
(modify-syntax-entry (car chars) "w")
(setq chars (cdr chars))))
(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")
(modify-category-entry (make-char 'japanese-jisx0208 35) ?A)
(modify-category-entry (make-char 'japanese-jisx0208 36) ?H)
(modify-category-entry (make-char 'japanese-jisx0208 37) ?K)
(modify-category-entry (make-char 'japanese-jisx0208 38) ?G)
(modify-category-entry (make-char 'japanese-jisx0208 39) ?Y)
(let ((row 48))
(while (< row 127)
(modify-category-entry (make-char 'japanese-jisx0208 row) ?C)
(setq row (1+ row))))
(modify-category-entry ?$B!<(B ?K)
(let ((chars '(?$B!+(B ?$B!,(B)))
(while chars
(modify-category-entry (car chars) ?K)
(modify-category-entry (car chars) ?H)
(setq chars (cdr chars))))
(let ((chars '(?$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)))
(while chars
(modify-category-entry (car chars) ?C)
(setq chars (cdr chars))))
;; JISX0212
(modify-syntax-entry (make-char 'japanese-jisx0212) "w")
(modify-syntax-entry (make-char 'japanese-jisx0212 33) "_")
(modify-syntax-entry (make-char 'japanese-jisx0212 34) "_")
(modify-syntax-entry (make-char 'japanese-jisx0212 35) "_")
(modify-category-entry (make-char 'japanese-jisx0212 ) ?C)
;; JISX0201-Kana
(modify-syntax-entry (make-char 'katakana-jisx0201) "w")
(let ((chars '(?(I!(B ?(I$(B ?(I%(B)))
(while chars
(modify-syntax-entry (car chars) ".")
(setq chars (cdr chars))))
(modify-syntax-entry ?\(I"(B "((I#(B")
(modify-syntax-entry ?\(I#(B "((I"(B")
;; Korean character set (KSC5601)
(modify-syntax-entry (make-char 'korean-ksc5601) "w")
(modify-syntax-entry (make-char 'korean-ksc5601 33) "_")
(modify-syntax-entry (make-char 'korean-ksc5601 34) "_")
(modify-syntax-entry (make-char 'korean-ksc5601 38) "_")
(modify-syntax-entry (make-char 'korean-ksc5601 39) "_")
(modify-syntax-entry (make-char 'korean-ksc5601 40) "_")
(modify-syntax-entry (make-char 'korean-ksc5601 41) "_")
(modify-category-entry (make-char 'korean-ksc5601) ?h)
(modify-category-entry (make-char 'korean-ksc5601 35) ?A)
(modify-category-entry (make-char 'korean-ksc5601 37) ?G)
(modify-category-entry (make-char 'korean-ksc5601 42) ?H)
(modify-category-entry (make-char 'korean-ksc5601 43) ?K)
(modify-category-entry (make-char 'korean-ksc5601 44) ?Y)
;; Latin character set (latin-1,2,3,4,5,8,9)
(modify-category-entry (make-char 'latin-iso8859-1) ?l)
(modify-category-entry (make-char 'latin-iso8859-2) ?l)
(modify-category-entry (make-char 'latin-iso8859-3) ?l)
(modify-category-entry (make-char 'latin-iso8859-4) ?l)
(modify-category-entry (make-char 'latin-iso8859-9) ?l)
(modify-category-entry (make-char 'latin-iso8859-14) ?l)
(modify-category-entry (make-char 'latin-iso8859-15) ?l)
(modify-category-entry (make-char 'latin-iso8859-1 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-2 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-3 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-4 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-9 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-14 160) ?\ )
(modify-category-entry (make-char 'latin-iso8859-15 160) ?\ )
;; Lao character set
(modify-category-entry (make-char 'lao) ?o)
(let ((deflist '(;; chars syntax category
("(1!(B-(1N(B" "w" ?0) ; consonant
("(1PRS]`(B-(1d(B" "w" ?1) ; vowel base
("(1QT(B-(1W[m(B" "w" ?2) ; vowel upper
("(1XY(B" "w" ?3) ; vowel lower
("(1h(B-(1l(B" "w" ?4) ; tone mark
("(1\(B" "w" ?9) ; semivowel lower
("(1p(B-(1y(B" "w" ?6) ; digit
("(1Of(B" "_" ?5) ; symbol
))
elm chars len syntax category to ch i)
(while deflist
(setq elm (car deflist))
(setq chars (car elm)
len (length chars)
syntax (nth 1 elm)
category (nth 2 elm)
i 0)
(while (< i len)
(if (= (aref chars i) ?-)
(setq i (1+ i)
to (aref chars i))
(setq ch (aref chars i)
to ch))
(while (<= ch to)
(modify-syntax-entry ch syntax)
(modify-category-entry ch category)
(setq ch (1+ ch)))
(setq i (1+ i)))
(setq deflist (cdr deflist))))
;; Thai character set (TIS620)
(modify-category-entry (make-char 'thai-tis620) ?t)
(let ((deflist '(;; chars syntax category
(",T!(B-,TCEG(B-,TN(B" "w" ?0) ; consonant
(",TDFPRS`(B-,Te(B" "w" ?1) ; vowel base
(",TQT(B-,TWgn(B" "w" ?2) ; vowel upper
(",TX(B-,TZ(B" "w" ?3) ; vowel lower
(",Th(B-,Tm(B" "w" ?4) ; tone mark
(",Tp(B-,Ty(B" "w" ?6) ; digit
(",TOf_oz{(B" "_" ?5) ; symbol
))
elm chars len syntax category to ch i)
(while deflist
(setq elm (car deflist))
(setq chars (car elm)
len (length chars)
syntax (nth 1 elm)
category (nth 2 elm)
i 0)
(while (< i len)
(if (= (aref chars i) ?-)
(setq i (1+ i)
to (aref chars i))
(setq ch (aref chars i)
to ch))
(while (<= ch to)
(modify-syntax-entry ch syntax)
(modify-category-entry ch category)
(setq ch (1+ ch)))
(setq i (1+ i)))
(setq deflist (cdr deflist))))
;; Tibetan character set
(modify-category-entry (make-char 'tibetan) ?q)
(modify-category-entry (make-char 'tibetan-1-column) ?q)
(let ((deflist '(;; chars syntax category
("$(7"!(B-$(7"J"K(B" "w" ?0) ;
consonant
("$(7#!(B-$(7#J#K#L#M!"!#(B" "w" ?0) ;
("$(7$!(B-$(7$e(B" "w" ?0) ;
("$(7%!(B-$(7%u(B" "w" ?0) ;
("$(7"S"["\"]"^"a(B" "w" ?2)
; upper vowel
("$(7"_"c"d"g"h"i"j"k"l(B"
"w" ?2) ; upper modifier
("$(7!I"Q"R"U"e!e!g(B" "w" ?3) ; lowel
vowel/modifier
("$(7!P(B-$(7!Y!Z(B-$(7!c(B" "w" ?6) ; digit
("$(7!;!=(B-$(7!B!D"`(B" "." ?|) ; line-break
char
("$(8!;!=!?!@!A!D"`(B" "." ?|) ;
("$(7!8!;!=(B-$(7!B!D"`!m!d(B" "." ?>) ;
prohibition
("$(8!;!=!?!@!A!D"`(B" "." ?>) ;
("$(7!0(B-$(7!:!l#R#S"f(B" "." ?<) ;
prohibition
("$(7!C!E(B-$(7!H!J(B-$(7!O!f!h(B-$(7!k!n!o#O#P(B-$(7#`(B"
"." ?q) ; others
))
elm chars len syntax category to ch i)
(while deflist
(setq elm (car deflist))
(setq chars (car elm)
len (length chars)
syntax (nth 1 elm)
category (nth 2 elm)
i 0)
(while (< i len)
(if (= (aref chars i) ?-)
(setq i (1+ i)
to (aref chars i))
(setq ch (aref chars i)
to ch))
(while (<= ch to)
(modify-syntax-entry ch syntax)
(modify-category-entry ch category)
(setq ch (1+ ch)))
(setq i (1+ i)))
(setq deflist (cdr deflist))))
;; Vietnamese character set
(let ((lower (make-char 'vietnamese-viscii-lower))
(upper (make-char 'vietnamese-viscii-upper)))
(modify-syntax-entry lower "w")
(modify-syntax-entry upper "w")
(modify-category-entry lower ?v)
(modify-category-entry upper ?v)
(modify-category-entry lower ?l) ; To make a word with
(modify-category-entry upper ?l) ; latin characters.
)
(let ((tbl (standard-case-table))
(i 32))
(while (< i 128)
(set-case-syntax-pair (make-char 'vietnamese-viscii-upper i)
(make-char 'vietnamese-viscii-lower i)
tbl)
(setq i (1+ i))))
;; Unicode (mule-unicode-0100-24ff)
(let ((tbl (standard-case-table)) c)
;; In some languages, U+0049 LATIN CAPITAL LETTER I and U+0131 LATIN
;; SMALL LETTER DOTLESS I make a case pair, and so do U+0130 LATIN
;; CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN SMALL LETTER I.
;; Thus we have to check language-environment to handle casing
;; correctly. Currently only I<->i is available.
;; case-syntax-pair's are not yet given for Latin Extendet-B
;; Latin Extended-A, Latin Extended-B
(setq c #x0100)
(while (<= c #x0233)
(modify-category-entry (decode-char 'ucs c) ?l)
(and (or (<= c #x012e)
(and (>= c #x014a) (<= c #x0177)))
(zerop (% c 2))
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
(and (>= c #x013a)
(<= c #x0148)
(zerop (% c 2))
(set-case-syntax-pair
(decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl))
(setq c (1+ c)))
(set-case-syntax-pair ?$,1 R(B ?$,1 S(B tbl)
(set-case-syntax-pair ?$,1 T(B ?$,1 U(B tbl)
(set-case-syntax-pair ?$,1 V(B ?$,1 W(B tbl)
; (set-case-syntax-pair ?$,1!8(B ?,A(B tbl) ; these two have different length!
(set-case-syntax-pair ?$,1!9(B ?$,1!:(B tbl)
(set-case-syntax-pair ?$,1!;(B ?$,1!<(B tbl)
(set-case-syntax-pair ?$,1!=(B ?$,1!>(B tbl)
;; Latin Extended Additional
(setq c #x1e00)
(while (<= c #x1ef9)
(modify-category-entry (decode-char 'ucs c) ?l)
(and (zerop (% c 2))
(or (<= c #x1e94) (>= c #x1ea0))
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
(setq c (1+ c)))
;; Greek
(setq c #x0370)
(while (<= c #x03ff)
(modify-category-entry (decode-char 'ucs c) ?g)
(if (or (and (>= c #x0391) (<= c #x03a1))
(and (>= c #x03a3) (<= c #x03ab)))
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
(and (>= c #x03da)
(<= c #x03ee)
(zerop (% c 2))
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
(setq c (1+ c)))
(set-case-syntax-pair ?$,1&f(B ?$,1',(B tbl)
(set-case-syntax-pair ?$,1&h(B ?$,1'-(B tbl)
(set-case-syntax-pair ?$,1&i(B ?$,1'.(B tbl)
(set-case-syntax-pair ?$,1&j(B ?$,1'/(B tbl)
(set-case-syntax-pair ?$,1&l(B ?$,1'L(B tbl)
(set-case-syntax-pair ?$,1&n(B ?$,1'M(B tbl)
(set-case-syntax-pair ?$,1&o(B ?$,1'N(B tbl)
;; Greek Extended
(setq c #x1f00)
(while (<= c #x1fff)
(modify-category-entry (decode-char 'ucs c) ?g)
(and (<= (logand c #x000f) 7)
(<= c #x1fa7)
(not (memq c '(#x1f50 #x1f52 #x1f54 #x1f56)))
(/= (logand c #x00f0) 7)
(set-case-syntax-pair
(decode-char 'ucs (+ c 8)) (decode-char 'ucs c) tbl))
(setq c (1+ c)))
(set-case-syntax-pair ?$,1qx(B ?$,1qp(B tbl)
(set-case-syntax-pair ?$,1qy(B ?$,1qq(B tbl)
(set-case-syntax-pair ?$,1qz(B ?$,1q0(B tbl)
(set-case-syntax-pair ?$,1q{(B ?$,1q1(B tbl)
(set-case-syntax-pair ?$,1q|(B ?$,1qs(B tbl)
(set-case-syntax-pair ?$,1r((B ?$,1q2(B tbl)
(set-case-syntax-pair ?$,1r)(B ?$,1q3(B tbl)
(set-case-syntax-pair ?$,1r*(B ?$,1q4(B tbl)
(set-case-syntax-pair ?$,1r+(B ?$,1q5(B tbl)
(set-case-syntax-pair ?$,1r,(B ?$,1r#(B tbl)
(set-case-syntax-pair ?$,1r8(B ?$,1r0(B tbl)
(set-case-syntax-pair ?$,1r9(B ?$,1r1(B tbl)
(set-case-syntax-pair ?$,1r:(B ?$,1q6(B tbl)
(set-case-syntax-pair ?$,1r;(B ?$,1q7(B tbl)
(set-case-syntax-pair ?$,1rH(B ?$,1r@(B tbl)
(set-case-syntax-pair ?$,1rI(B ?$,1rA(B tbl)
(set-case-syntax-pair ?$,1rJ(B ?$,1q:(B tbl)
(set-case-syntax-pair ?$,1rK(B ?$,1q;(B tbl)
(set-case-syntax-pair ?$,1rL(B ?$,1rE(B tbl)
(set-case-syntax-pair ?$,1rX(B ?$,1q8(B tbl)
(set-case-syntax-pair ?$,1rY(B ?$,1q9(B tbl)
(set-case-syntax-pair ?$,1rZ(B ?$,1q<(B tbl)
(set-case-syntax-pair ?$,1r[(B ?$,1q=(B tbl)
(set-case-syntax-pair ?$,1r\(B ?$,1rS(B tbl)
;; cyrillic
(setq c #x0400)
(while (<= c #x04ff)
(modify-category-entry (decode-char 'ucs c) ?y)
(and (>= c #x0400)
(<= c #x040f)
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (+ c 80)) tbl))
(and (>= c #x0410)
(<= c #x042f)
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
(and (zerop (% c 2))
(or (and (>= c #x0460) (<= c #x0480))
(and (>= c #x048c) (<= c #x04be))
(and (>= c #x04d0) (<= c #x04f4)))
(set-case-syntax-pair
(decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
(setq c (1+ c)))
(set-case-syntax-pair ?$,1*!(B ?$,1*"(B tbl)
(set-case-syntax-pair ?$,1*#(B ?$,1*$(B tbl)
(set-case-syntax-pair ?$,1*'(B ?$,1*((B tbl)
(set-case-syntax-pair ?$,1*+(B ?$,1*,(B tbl)
(set-case-syntax-pair ?$,1*X(B ?$,1*Y(B tbl)
;; general punctuation
(setq c #x2000)
(while (<= c #x200b)
(set-case-syntax c " " tbl)
(setq c (1+ c)))
(setq c #x2010)
(while (<= c #x2027)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
)
;;; Setting word boundary.
(setq word-combining-categories
'((?l . ?l)))
(setq word-separating-categories ; (2-byte character sets)
'((?A . ?K) ; Alpha numeric - Katakana
(?A . ?C) ; Alpha numeric - Chinese
(?H . ?A) ; Hiragana - Alpha numeric
(?H . ?K) ; Hiragana - Katakana
(?H . ?C) ; Hiragana - Chinese
(?K . ?A) ; Katakana - Alpha numeric
(?K . ?C) ; Katakana - Chinese
(?C . ?A) ; Chinese - Alpha numeric
(?C . ?K) ; Chinese - Katakana
))
;; For each character set, put the information of the most proper
;; coding system to encode it by `preferred-coding-system' property.
(let ((l '((latin-iso8859-1 . iso-latin-1)
(latin-iso8859-2 . iso-latin-2)
(latin-iso8859-3 . iso-latin-3)
(latin-iso8859-4 . iso-latin-4)
(thai-tis620 . thai-tis620)
(greek-iso8859-7 . greek-iso-8bit)
(arabic-iso8859-6 . iso-2022-7bit)
(hebrew-iso8859-8 . hebrew-iso-8bit)
(katakana-jisx0201 . japanese-shift-jis)
(latin-jisx0201 . japanese-shift-jis)
(cyrillic-iso8859-5 . cyrillic-iso-8bit)
(latin-iso8859-9 . iso-latin-5)
(japanese-jisx0208-1978 . iso-2022-jp)
(chinese-gb2312 . cn-gb-2312)
(japanese-jisx0208 . iso-2022-jp)
(korean-ksc5601 . iso-2022-kr)
(japanese-jisx0212 . iso-2022-jp)
(chinese-cns11643-1 . iso-2022-cn)
(chinese-cns11643-2 . iso-2022-cn)
(chinese-big5-1 . chinese-big5)
(chinese-big5-2 . chinese-big5)
(chinese-sisheng . iso-2022-7bit)
(ipa . iso-2022-7bit)
(vietnamese-viscii-lower . vietnamese-viscii)
(vietnamese-viscii-upper . vietnamese-viscii)
(arabic-digit . iso-2022-7bit)
(arabic-1-column . iso-2022-7bit)
(ascii-right-to-left . iso-2022-7bit)
(lao . lao)
(arabic-2-column . iso-2022-7bit)
(indian-is13194 . devanagari)
(indian-1-column . devanagari)
(tibetan-1-column . tibetan)
(ethiopic . iso-2022-7bit)
(chinese-cns11643-3 . iso-2022-cn)
(chinese-cns11643-4 . iso-2022-cn)
(chinese-cns11643-5 . iso-2022-cn)
(chinese-cns11643-6 . iso-2022-cn)
(chinese-cns11643-7 . iso-2022-cn)
(indian-2-column . devanagari)
(tibetan . tibetan)
(latin-iso8859-14 . iso-latin-8)
(latin-iso8859-15 . iso-latin-9))))
(while l
(put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
(setq l (cdr l))))
;; Setup auto-fill-chars for charsets that should invoke auto-filling.
;; SPACE and NEWLIE are already set. Also put `nospace-between-words'
;; property to the charsets.
(let ((l '(katakana-jisx0201
japanese-jisx0208 japanese-jisx0212
chinese-gb2312 chinese-big5-1 chinese-big5-2)))
(while l
(aset auto-fill-chars (make-char (car l)) t)
(put-charset-property (car l) 'nospace-between-words t)
(setq l (cdr l))))
;;; Local Variables:
;;; coding: iso-2022-7bit
;;; End:
;;; end of characters.el