01939ad9419c3d937b783c38ca84422cffffdfd1
[bpt/emacs.git] / lisp / international / characters.el
1 ;;; characters.el --- set syntax and category for multibyte characters
2
3 ;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4 ;; Free Software Foundation, Inc.
5 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
6 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
7 ;; National Institute of Advanced Industrial Science and Technology (AIST)
8 ;; Registration Number H14PRO021
9 ;; Copyright (C) 2003
10 ;; National Institute of Advanced Industrial Science and Technology (AIST)
11 ;; Registration Number H13PRO009
12
13 ;; Keywords: multibyte character, character set, syntax, category
14
15 ;; This file is part of GNU Emacs.
16
17 ;; GNU Emacs is free software: you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation, either version 3 of the License, or
20 ;; (at your option) any later version.
21
22 ;; GNU Emacs is distributed in the hope that it will be useful,
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 ;; GNU General Public License for more details.
26
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29
30 ;;; Commentary:
31
32 ;;; Code:
33
34 ;;; Predefined categories.
35
36 ;; For each character set.
37
38 (define-category ?a "ASCII
39 ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])")
40 (define-category ?l "Latin")
41 (define-category ?t "Thai")
42 (define-category ?g "Greek")
43 (define-category ?b "Arabic")
44 (define-category ?w "Hebrew")
45 (define-category ?y "Cyrillic")
46 (define-category ?k "Katakana
47 Japanese katakana")
48 (define-category ?r "Roman
49 Japanese roman")
50 (define-category ?c "Chinese")
51 (define-category ?j "Japanese")
52 (define-category ?h "Korean")
53 (define-category ?e "Ethiopic
54 Ethiopic (Ge'ez)")
55 (define-category ?v "Viet
56 Vietnamese")
57 (define-category ?i "Indian")
58 (define-category ?o "Lao")
59 (define-category ?q "Tibetan")
60
61 ;; For each group (row) of 2-byte character sets.
62
63 (define-category ?A "2-byte alnum
64 Alpha-numeric characters of 2-byte character sets")
65 (define-category ?C "2-byte han
66 Chinese (Han) characters of 2-byte character sets")
67 (define-category ?G "2-byte Greek
68 Greek characters of 2-byte character sets")
69 (define-category ?H "2-byte Hiragana
70 Japanese Hiragana characters of 2-byte character sets")
71 (define-category ?K "2-byte Katakana
72 Japanese Katakana characters of 2-byte character sets")
73 (define-category ?N "2-byte Korean
74 Korean Hangul characters of 2-byte character sets")
75 (define-category ?Y "2-byte Cyrillic
76 Cyrillic characters of 2-byte character sets")
77 (define-category ?I "Indian Glyphs")
78
79 ;; For phonetic classifications.
80
81 (define-category ?0 "consonant")
82 (define-category ?1 "base vowel
83 Base (independent) vowel")
84 (define-category ?2 "upper diacritic
85 Upper diacritical mark (including upper vowel)")
86 (define-category ?3 "lower diacritic
87 Lower diacritical mark (including lower vowel)")
88 (define-category ?4 "combining tone
89 Combining tone mark")
90 (define-category ?5 "symbol")
91 (define-category ?6 "digit")
92 (define-category ?7 "vowel diacritic
93 Vowel-modifying diacritical mark")
94 (define-category ?8 "vowel-signs")
95 (define-category ?9 "semivowel lower")
96
97 ;; For filling.
98 (define-category ?| "line breakable
99 While filling, we can break a line at this character.")
100
101 ;; For indentation calculation.
102 (define-category ?\s
103 "space for indent
104 This character counts as a space for indentation purposes.")
105
106 ;; Keep the following for `kinsoku' processing. See comments in
107 ;; kinsoku.el.
108 (define-category ?> "Not at bol
109 A character which can't be placed at beginning of line.")
110 (define-category ?< "Not at eol
111 A character which can't be placed at end of line.")
112
113 ;; Base and Combining
114 (define-category ?. "Base
115 Base characters (Unicode General Category L,N,P,S,Zs)")
116 (define-category ?^ "Combining
117 Combining diacritic or mark (Unicode General Category M)")
118 \f
119 ;;; Setting syntax and category.
120
121 ;; ASCII
122
123 ;; All ASCII characters have the category `a' (ASCII) and `l' (Latin).
124 (modify-category-entry '(32 . 127) ?a)
125 (modify-category-entry '(32 . 127) ?l)
126
127 ;; Deal with the CJK charsets first. Since the syntax of blocks is
128 ;; defined per charset, and the charsets may contain e.g. Latin
129 ;; characters, we end up with the wrong syntax definitions if we're
130 ;; not careful.
131
132 ;; Chinese characters (Unicode)
133 (modify-category-entry '(#x2E80 . #x312F) ?|)
134 (modify-category-entry '(#x3190 . #x33FF) ?|)
135 (modify-category-entry '(#x3400 . #x4DBF) ?C)
136 (modify-category-entry '(#x4E00 . #x9FAF) ?C)
137 (modify-category-entry '(#x3400 . #x9FAF) ?c)
138 (modify-category-entry '(#x3400 . #x9FAF) ?|)
139 (modify-category-entry '(#xF900 . #xFAFF) ?C)
140 (modify-category-entry '(#xF900 . #xFAFF) ?c)
141 (modify-category-entry '(#xF900 . #xFAFF) ?|)
142 (modify-category-entry '(#x20000 . #x2FFFF) ?|)
143 (modify-category-entry '(#x20000 . #x2FFFF) ?C)
144 (modify-category-entry '(#x20000 . #x2FFFF) ?c)
145
146
147 ;; Chinese character set (GB2312)
148
149 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2121 #x217E)
150 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2221 #x227E)
151 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2921 #x297E)
152
153 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?c)
154 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2330 #x2339)
155 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2341 #x235A)
156 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2361 #x237A)
157 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?H #x2421 #x247E)
158 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?K #x2521 #x257E)
159 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?G #x2621 #x267E)
160 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?Y #x2721 #x277E)
161 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?C #x3021 #x7E7E)
162
163 ;; Chinese character set (BIG5)
164
165 (map-charset-chars #'modify-category-entry 'big5 ?c)
166 (map-charset-chars #'modify-category-entry 'big5 ?C #xA259 #xA261)
167 (map-charset-chars #'modify-category-entry 'big5 ?C #xA440 #xC67E)
168 (map-charset-chars #'modify-category-entry 'big5 ?C #xC940 #xF9DC)
169
170 ;; Chinese character set (CNS11643)
171
172 (dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
173 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
174 chinese-cns11643-7))
175 (map-charset-chars #'modify-category-entry c ?c)
176 (if (eq c 'chinese-cns11643-1)
177 (map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E)
178 (map-charset-chars #'modify-category-entry c ?C)))
179
180 ;; Japanese character set (JISX0201, JISX0208, JISX0212, JISX0213)
181
182 (map-charset-chars #'modify-category-entry 'katakana-jisx0201 ?k)
183
184 (map-charset-chars #'modify-category-entry 'latin-jisx0201 ?r)
185
186 (dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212
187 japanese-jisx0213-1 japanese-jisx0213-2
188 cp932-2-byte))
189 (map-charset-chars #'modify-category-entry l ?j))
190
191 ;; Fullwidth characters
192 (modify-category-entry '(#xff01 . #xff60) ?\|)
193
194 ;; Unicode equivalents of JISX0201-kana
195 (let ((range '(#xff61 . #xff9f)))
196 (modify-category-entry range ?k)
197 (modify-category-entry range ?j)
198 (modify-category-entry range ?\|))
199
200 ;; Katakana block
201 (modify-category-entry '(#x3099 . #x309C) ?K)
202 (modify-category-entry '(#x30A0 . #x30FF) ?K)
203 (modify-category-entry '(#x31F0 . #x31FF) ?K)
204 (modify-category-entry '(#x30A0 . #x30FA) ?\|)
205 (modify-category-entry #x30FF ?\|)
206
207 ;; Hiragana block
208 (modify-category-entry '(#x3040 . #x309F) ?H)
209 (modify-category-entry '(#x3040 . #x3096) ?\|)
210 (modify-category-entry #x309F ?\|)
211 (modify-category-entry #x30A0 ?H)
212 (modify-category-entry #x30FC ?H)
213
214
215 ;; JISX0208
216 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
217 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
218 (let ((chars '(?ー ?゛ ?゜ ?ヽ ?ヾ ?ゝ ?ゞ ?〃 ?仝 ?々 ?〆 ?〇)))
219 (dolist (elt chars)
220 (modify-syntax-entry (car chars) "w")))
221
222 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?A #x2321 #x237E)
223 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?H #x2421 #x247E)
224 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?K #x2521 #x257E)
225 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?G #x2621 #x267E)
226 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?Y #x2721 #x277E)
227 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?C #x3021 #x7E7E)
228 (modify-category-entry ?ー ?K)
229 (let ((chars '(?゛ ?゜)))
230 (while chars
231 (modify-category-entry (car chars) ?K)
232 (modify-category-entry (car chars) ?H)
233 (setq chars (cdr chars))))
234 (let ((chars '(?仝 ?々 ?〆 ?〇)))
235 (while chars
236 (modify-category-entry (car chars) ?C)
237 (setq chars (cdr chars))))
238
239 ;; JISX0212
240
241 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0212 "_" #x2121 #x237E)
242
243 ;; JISX0201-Kana
244
245 (let ((chars '(?。 ?、 ?・)))
246 (while chars
247 (modify-syntax-entry (car chars) ".")
248 (setq chars (cdr chars))))
249
250 (modify-syntax-entry ?\「 "(」")
251 (modify-syntax-entry ?\」 "(「")
252
253 ;; Korean character set (KSC5601)
254
255 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?h)
256
257 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
258 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
259 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
260 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
261 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
262 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
263 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
264 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?G #x2521 #x257E)
265 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?H #x2A21 #x2A7E)
266 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?K #x2B21 #x2B7E)
267 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?Y #x2C21 #x2C7E)
268
269 ;; These are in more than one charset.
270 (let ((parens (concat "〈〉《》「」『』【】〔〕〖〗〘〙〚〛"
271 "︵︶︷︸︹︺︻︼︽︾︿﹀﹁﹂﹃﹄"
272 "()[]{}"))
273 open close)
274 (dotimes (i (/ (length parens) 2))
275 (setq open (aref parens (* i 2))
276 close (aref parens (1+ (* i 2))))
277 (modify-syntax-entry open (format "(%c" close))
278 (modify-syntax-entry close (format ")%c" open))))
279
280 ;; Arabic character set
281
282 (let ((charsets '(arabic-iso8859-6
283 arabic-digit
284 arabic-1-column
285 arabic-2-column)))
286 (while charsets
287 (map-charset-chars #'modify-category-entry (car charsets) ?b)
288 (setq charsets (cdr charsets))))
289 (modify-category-entry '(#x600 . #x6ff) ?b)
290 (modify-category-entry '(#xfb50 . #xfdff) ?b)
291 (modify-category-entry '(#xfe70 . #xfefe) ?b)
292
293 ;; Cyrillic character set (ISO-8859-5)
294
295 (modify-syntax-entry ?№ ".")
296
297 ;; Ethiopic character set
298
299 (modify-category-entry '(#x1200 . #x1399) ?e)
300 (modify-category-entry '(#x2d80 . #x2dde) ?e)
301 (let ((chars '(?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨)))
302 (while chars
303 (modify-syntax-entry (car chars) ".")
304 (setq chars (cdr chars))))
305 (map-charset-chars #'modify-category-entry 'ethiopic ?e)
306
307 ;; Hebrew character set (ISO-8859-8)
308
309 (modify-syntax-entry #x5be ".") ; MAQAF
310 (modify-syntax-entry #x5c0 ".") ; PASEQ
311 (modify-syntax-entry #x5c3 ".") ; SOF PASUQ
312 (modify-syntax-entry #x5f3 ".") ; GERESH
313 (modify-syntax-entry #x5f4 ".") ; GERSHAYIM
314
315 ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
316
317 (modify-category-entry '(#x901 . #x970) ?i)
318 (map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
319 (map-charset-chars #'modify-category-entry 'indian-2-column ?i)
320
321 ;; Lao character set
322
323 (modify-category-entry '(#xe80 . #xeff) ?o)
324 (map-charset-chars #'modify-category-entry 'lao ?o)
325
326 (let ((deflist '(("ກ-ຮ" "w" ?0) ; consonant
327 ("ະາຳຽເ-ໄ" "w" ?1) ; vowel base
328 ("ັິ-ືົໍ" "w" ?2) ; vowel upper
329 ("ຸູ" "w" ?3) ; vowel lower
330 ("່-໋" "w" ?4) ; tone mark
331 ("ຼຽ" "w" ?9) ; semivowel lower
332 ("໐-໙" "w" ?6) ; digit
333 ("ຯໆ" "_" ?5) ; symbol
334 ))
335 elm chars len syntax category to ch i)
336 (while deflist
337 (setq elm (car deflist))
338 (setq chars (car elm)
339 len (length chars)
340 syntax (nth 1 elm)
341 category (nth 2 elm)
342 i 0)
343 (while (< i len)
344 (if (= (aref chars i) ?-)
345 (setq i (1+ i)
346 to (aref chars i))
347 (setq ch (aref chars i)
348 to ch))
349 (while (<= ch to)
350 (unless (string-equal syntax "w")
351 (modify-syntax-entry ch syntax))
352 (modify-category-entry ch category)
353 (setq ch (1+ ch)))
354 (setq i (1+ i)))
355 (setq deflist (cdr deflist))))
356
357 ;; Thai character set (TIS620)
358
359 (modify-category-entry '(#xe00 . #xe7f) ?t)
360 (map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
361
362 (let ((deflist '(;; chars syntax category
363 ("ก-รลว-ฮ" "w" ?0) ; consonant
364 ("ฤฦะาำเ-ๅ" "w" ?1) ; vowel base
365 ("ัิ-ื็๎" "w" ?2) ; vowel upper
366 ("ุ-ฺ" "w" ?3) ; vowel lower
367 ("่-ํ" "w" ?4) ; tone mark
368 ("๐-๙" "w" ?6) ; digit
369 ("ฯๆ฿๏๚๛" "_" ?5) ; symbol
370 ))
371 elm chars len syntax category to ch i)
372 (while deflist
373 (setq elm (car deflist))
374 (setq chars (car elm)
375 len (length chars)
376 syntax (nth 1 elm)
377 category (nth 2 elm)
378 i 0)
379 (while (< i len)
380 (if (= (aref chars i) ?-)
381 (setq i (1+ i)
382 to (aref chars i))
383 (setq ch (aref chars i)
384 to ch))
385 (while (<= ch to)
386 (unless (string-equal syntax "w")
387 (modify-syntax-entry ch syntax))
388 (modify-category-entry ch category)
389 (setq ch (1+ ch)))
390 (setq i (1+ i)))
391 (setq deflist (cdr deflist))))
392
393 ;; Tibetan character set
394
395 (modify-category-entry '(#xf00 . #xfff) ?q)
396 (map-charset-chars #'modify-category-entry 'tibetan ?q)
397 (map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
398
399 (let ((deflist '(;; chars syntax category
400 ("ཀ-ཀྵཪ" "w" ?0) ; consonant
401 ("ྐ-ྐྵྺྻྼ" "w" ?0) ;
402 ("ིེཻོཽྀ" "w" ?2) ; upper vowel
403 ("ཾྂྃ྆྇ྈྉྊྋ" "w" ?2) ; upper modifier
404 ("྄ཱུ༙༵༷" "w" ?3) ; lowel vowel/modifier
405 ("཰" "w" ?3) ; invisible vowel a
406 ("༠-༩༪-༳" "w" ?6) ; digit
407 ("་།-༒༔ཿ" "." ?|) ; line-break char
408 ("་།༏༐༑༔ཿ" "." ?|) ;
409 ("༈་།-༒༔ཿ༽༴" "." ?>) ; prohibition
410 ("་།༏༐༑༔ཿ" "." ?>) ;
411 ("ༀ-༊༼࿁࿂྅" "." ?<) ; prohibition
412 ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
413 ))
414 elm chars len syntax category to ch i)
415 (while deflist
416 (setq elm (car deflist))
417 (setq chars (car elm)
418 len (length chars)
419 syntax (nth 1 elm)
420 category (nth 2 elm)
421 i 0)
422 (while (< i len)
423 (if (= (aref chars i) ?-)
424 (setq i (1+ i)
425 to (aref chars i))
426 (setq ch (aref chars i)
427 to ch))
428 (while (<= ch to)
429 (unless (string-equal syntax "w")
430 (modify-syntax-entry ch syntax))
431 (modify-category-entry ch category)
432 (setq ch (1+ ch)))
433 (setq i (1+ i)))
434 (setq deflist (cdr deflist))))
435
436 ;; Vietnamese character set
437
438 ;; To make a word with Latin characters
439 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
440 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
441
442 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
443 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
444
445 (let ((tbl (standard-case-table))
446 (i 32))
447 (while (< i 128)
448 (let* ((char (decode-char 'vietnamese-viscii-upper i))
449 (charl (decode-char 'vietnamese-viscii-lower i))
450 (uc (encode-char char 'ucs))
451 (lc (encode-char charl 'ucs)))
452 (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
453 tbl)
454 (if uc (modify-category-entry uc ?v))
455 (if lc (modify-category-entry lc ?v)))
456 (setq i (1+ i))))
457
458 ;; Tai Viet
459 (let ((deflist '(;; chars syntax category
460 ((?ꪀ. ?ꪯ) "w" ?0) ; cosonant
461 ("ꪱꪵꪶ" "w" ?1) ; vowel base
462 ((?ꪹ . ?ꪽ) "w" ?1) ; vowel base
463 ("ꪰꪲꪳꪷꪸꪾ" "w" ?2) ; vowel upper
464 ("ꪴ" "w" ?3) ; vowel lower
465 ("ꫀꫂ" "w" ?1) ; non-combining tone-mark
466 ("꪿꫁" "w" ?4) ; combining tone-mark
467 ((?ꫛ . ?꫟) "_" ?5) ; symbol
468 )))
469 (dolist (elm deflist)
470 (let ((chars (car elm))
471 (syntax (nth 1 elm))
472 (category (nth 2 elm)))
473 (if (consp chars)
474 (progn
475 (modify-syntax-entry chars syntax)
476 (modify-category-entry chars category))
477 (mapc #'(lambda (x)
478 (modify-syntax-entry x syntax)
479 (modify-category-entry x category))
480 chars)))))
481
482 ;; Latin
483
484 (modify-category-entry '(#x80 . #x024F) ?l)
485
486 (let ((tbl (standard-case-table)) c)
487
488 ;; Latin-1
489
490 ;; Fixme: Some of the non-word syntaxes here perhaps should be
491 ;; reviewed. (Note that the following all implicitly have word
492 ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
493 ;; relating Unicode categories to Emacs syntax codes.
494
495 ;; NBSP isn't semantically interchangeable with other whitespace chars,
496 ;; so it's more like punctation.
497 (set-case-syntax"." tbl)
498 (set-case-syntax"." tbl)
499 (set-case-syntax"_" tbl)
500 (set-case-syntax"." tbl)
501 (set-case-syntax"_" tbl)
502 (set-case-syntax-delims 171 187 tbl) ; « »
503 (set-case-syntax"_" tbl)
504 (set-case-syntax"_" tbl)
505 (set-case-syntax"_" tbl)
506 (set-case-syntax"_" tbl)
507 (set-case-syntax"_" tbl)
508 (set-case-syntax"_" tbl)
509 (set-case-syntax"_" tbl)
510 (set-case-syntax"_" tbl)
511 (set-case-syntax"_" tbl)
512 (set-case-syntax"_" tbl)
513 (set-case-syntax ?¿ "." tbl)
514 (let ((c 192))
515 (while (<= c 222)
516 (set-case-syntax-pair c (+ c 32) tbl)
517 (setq c (1+ c))))
518 (set-case-syntax"_" tbl)
519 (set-case-syntax"w" tbl)
520 (set-case-syntax"_" tbl)
521 ;; See below for ÿ.
522
523 ;; Latin Extended-A, Latin Extended-B
524 (setq c #x0100)
525 (while (<= c #x02B8)
526 (modify-category-entry c ?l)
527 (setq c (1+ c)))
528
529 (let ((pair-ranges '((#x0100 . #x012F)
530 (#x0132 . #x0137)
531 (#x0139 . #x0148)
532 (#x014a . #x0177)
533 (#x0179 . #x017E)
534 (#x0182 . #x0185)
535 (#x0187 . #x0188)
536 (#x018B . #x018C)
537 (#x0191 . #x0192)
538 (#x0198 . #x0199)
539 (#x01A0 . #x01A5)
540 (#x01A7 . #x01A8)
541 (#x01AC . #x01AD)
542 (#x01AF . #x01B0)
543 (#x01B3 . #x01B6)
544 (#x01BC . #x01BD)
545 (#x01CD . #x01DC)
546 (#x01DE . #x01EF)
547 (#x01F4 . #x01F5)
548 (#x01F8 . #x021F)
549 (#x0222 . #x0233)
550 (#x023B . #x023C)
551 (#x0241 . #x0242)
552 (#x0246 . #x024F))))
553 (dolist (elt pair-ranges)
554 (let ((from (car elt)) (to (cdr elt)))
555 (while (< from to)
556 (set-case-syntax-pair from (1+ from) tbl)
557 (setq from (+ from 2))))))
558
559 (set-case-syntax-pair #x189 #x256 tbl)
560 (set-case-syntax-pair #x18A #x257 tbl)
561
562 ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
563 ;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
564 ;; do U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN
565 ;; SMALL LETTER I.
566
567 ;; We used to set up half of those correspondence unconditionally,
568 ;; but that makes searches slow. So now we don't set up either half
569 ;; of these correspondences by default.
570
571 ;; (set-downcase-syntax ?İ ?i tbl)
572 ;; (set-upcase-syntax ?I ?ı tbl)
573
574 (set-case-syntax-pair ?DŽ ?dž tbl)
575 (set-case-syntax-pair ?Dž ?dž tbl)
576 (set-case-syntax-pair ?LJ ?lj tbl)
577 (set-case-syntax-pair ?Lj ?lj tbl)
578 (set-case-syntax-pair ?NJ ?nj tbl)
579 (set-case-syntax-pair ?Nj ?nj tbl)
580
581 ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
582 (set-case-syntax-pair ?DZ ?dz tbl)
583 (set-case-syntax-pair ?Dz ?dz tbl)
584 (set-case-syntax-pair ?Ƕ ?ƕ tbl)
585 (set-case-syntax-pair ?Ƿ ?ƿ tbl)
586
587 ;; Latin Extended Additional
588 (modify-category-entry '(#x1e00 . #x1ef9) ?l)
589 (setq c #x1e00)
590 (while (<= c #x1ef9)
591 (and (zerop (% c 2))
592 (or (<= c #x1e94) (>= c #x1ea0))
593 (set-case-syntax-pair c (1+ c) tbl))
594 (setq c (1+ c)))
595
596 ;; Greek
597 (modify-category-entry '(#x0370 . #x03ff) ?g)
598 (setq c #x0370)
599 (while (<= c #x03ff)
600 (if (or (and (>= c #x0391) (<= c #x03a1))
601 (and (>= c #x03a3) (<= c #x03ab)))
602 (set-case-syntax-pair c (+ c 32) tbl))
603 (and (>= c #x03da)
604 (<= c #x03ee)
605 (zerop (% c 2))
606 (set-case-syntax-pair c (1+ c) tbl))
607 (setq c (1+ c)))
608 (set-case-syntax-pair ?Ά ?ά tbl)
609 (set-case-syntax-pair ?Έ ?έ tbl)
610 (set-case-syntax-pair ?Ή ?ή tbl)
611 (set-case-syntax-pair ?Ί ?ί tbl)
612 (set-case-syntax-pair ?Ό ?ό tbl)
613 (set-case-syntax-pair ?Ύ ?ύ tbl)
614 (set-case-syntax-pair ?Ώ ?ώ tbl)
615
616 ;; Armenian
617 (setq c #x531)
618 (while (<= c #x556)
619 (set-case-syntax-pair c (+ c #x30) tbl)
620 (setq c (1+ c)))
621
622 ;; Greek Extended
623 (modify-category-entry '(#x1f00 . #x1fff) ?g)
624 (setq c #x1f00)
625 (while (<= c #x1fff)
626 (and (<= (logand c #x000f) 7)
627 (<= c #x1fa7)
628 (not (memq c '(#x1f16 #x1f17 #x1f56 #x1f57
629 #x1f50 #x1f52 #x1f54 #x1f56)))
630 (/= (logand c #x00f0) #x70)
631 (set-case-syntax-pair (+ c 8) c tbl))
632 (setq c (1+ c)))
633 (set-case-syntax-pair ?Ᾰ ?ᾰ tbl)
634 (set-case-syntax-pair ?Ᾱ ?ᾱ tbl)
635 (set-case-syntax-pair ?Ὰ ?ὰ tbl)
636 (set-case-syntax-pair ?Ά ?ά tbl)
637 (set-case-syntax-pair ?ᾼ ?ᾳ tbl)
638 (set-case-syntax-pair ?Ὲ ?ὲ tbl)
639 (set-case-syntax-pair ?Έ ?έ tbl)
640 (set-case-syntax-pair ?Ὴ ?ὴ tbl)
641 (set-case-syntax-pair ?Ή ?ή tbl)
642 (set-case-syntax-pair ?ῌ ?ῃ tbl)
643 (set-case-syntax-pair ?Ῐ ?ῐ tbl)
644 (set-case-syntax-pair ?Ῑ ?ῑ tbl)
645 (set-case-syntax-pair ?Ὶ ?ὶ tbl)
646 (set-case-syntax-pair ?Ί ?ί tbl)
647 (set-case-syntax-pair ?Ῠ ?ῠ tbl)
648 (set-case-syntax-pair ?Ῡ ?ῡ tbl)
649 (set-case-syntax-pair ?Ὺ ?ὺ tbl)
650 (set-case-syntax-pair ?Ύ ?ύ tbl)
651 (set-case-syntax-pair ?Ῥ ?ῥ tbl)
652 (set-case-syntax-pair ?Ὸ ?ὸ tbl)
653 (set-case-syntax-pair ?Ό ?ό tbl)
654 (set-case-syntax-pair ?Ὼ ?ὼ tbl)
655 (set-case-syntax-pair ?Ώ ?ώ tbl)
656 (set-case-syntax-pair ?ῼ ?ῳ tbl)
657
658 ;; cyrillic
659 (modify-category-entry '(#x0400 . #x04FF) ?y)
660 (setq c #x0400)
661 (while (<= c #x04ff)
662 (and (>= c #x0400)
663 (<= c #x040f)
664 (set-case-syntax-pair c (+ c 80) tbl))
665 (and (>= c #x0410)
666 (<= c #x042f)
667 (set-case-syntax-pair c (+ c 32) tbl))
668 (and (zerop (% c 2))
669 (or (and (>= c #x0460) (<= c #x0480))
670 (and (>= c #x048c) (<= c #x04be))
671 (and (>= c #x04d0) (<= c #x04f4)))
672 (set-case-syntax-pair c (1+ c) tbl))
673 (setq c (1+ c)))
674 (set-case-syntax-pair ?Ӂ ?ӂ tbl)
675 (set-case-syntax-pair ?Ӄ ?ӄ tbl)
676 (set-case-syntax-pair ?Ӈ ?ӈ tbl)
677 (set-case-syntax-pair ?Ӌ ?ӌ tbl)
678 (set-case-syntax-pair ?Ӹ ?ӹ tbl)
679
680 ;; general punctuation
681 (setq c #x2000)
682 (while (<= c #x200b)
683 (set-case-syntax c " " tbl)
684 (setq c (1+ c)))
685 (while (<= c #x200F)
686 (set-case-syntax c "." tbl)
687 (setq c (1+ c)))
688 ;; Fixme: These aren't all right:
689 (setq c #x2010)
690 (while (<= c #x2016)
691 (set-case-syntax c "_" tbl)
692 (setq c (1+ c)))
693 ;; Punctuation syntax for quotation marks (like `)
694 (while (<= c #x201f)
695 (set-case-syntax c "." tbl)
696 (setq c (1+ c)))
697 ;; Fixme: These aren't all right:
698 (while (<= c #x2027)
699 (set-case-syntax c "_" tbl)
700 (setq c (1+ c)))
701 (while (<= c #x206F)
702 (set-case-syntax c "." tbl)
703 (setq c (1+ c)))
704
705 ;; Roman numerals
706 (setq c #x2160)
707 (while (<= c #x216f)
708 (set-case-syntax-pair c (+ c #x10) tbl)
709 (setq c (1+ c)))
710
711 ;; Fixme: The following blocks might be better as symbol rather than
712 ;; punctuation.
713 ;; Arrows
714 (setq c #x2190)
715 (while (<= c #x21FF)
716 (set-case-syntax c "." tbl)
717 (setq c (1+ c)))
718 ;; Mathematical Operators
719 (while (<= c #x22FF)
720 (set-case-syntax c "." tbl)
721 (setq c (1+ c)))
722 ;; Miscellaneous Technical
723 (while (<= c #x23FF)
724 (set-case-syntax c "." tbl)
725 (setq c (1+ c)))
726 ;; Control Pictures
727 (while (<= c #x243F)
728 (set-case-syntax c "_" tbl)
729 (setq c (1+ c)))
730
731 ;; Circled Latin
732 (setq c #x24b6)
733 (while (<= c #x24cf)
734 (set-case-syntax-pair c (+ c 26) tbl)
735 (modify-category-entry c ?l)
736 (modify-category-entry (+ c 26) ?l)
737 (setq c (1+ c)))
738
739 ;; Fullwidth Latin
740 (setq c #xff21)
741 (while (<= c #xff3a)
742 (set-case-syntax-pair c (+ c #x20) tbl)
743 (modify-category-entry c ?l)
744 (modify-category-entry (+ c #x20) ?l)
745 (setq c (1+ c)))
746
747 ;; Combining diacritics
748 (modify-category-entry '(#x300 . #x362) ?^)
749 ;; Combining marks
750 (modify-category-entry '(#x20d0 . #x20e3) ?^)
751
752 ;; Fixme: syntax for symbols &c
753 )
754
755 (let ((pairs
756 '("⁅⁆" ; U+2045 U+2046
757 "⁽⁾" ; U+207D U+207E
758 "₍₎" ; U+208D U+208E
759 "〈〉" ; U+2329 U+232A
760 "⎴⎵" ; U+23B4 U+23B5
761 "❨❩" ; U+2768 U+2769
762 "❪❫" ; U+276A U+276B
763 "❬❭" ; U+276C U+276D
764 "❰❱" ; U+2770 U+2771
765 "❲❳" ; U+2772 U+2773
766 "❴❵" ; U+2774 U+2775
767 "⟦⟧" ; U+27E6 U+27E7
768 "⟨⟩" ; U+27E8 U+27E9
769 "⟪⟫" ; U+27EA U+27EB
770 "⦃⦄" ; U+2983 U+2984
771 "⦅⦆" ; U+2985 U+2986
772 "⦇⦈" ; U+2987 U+2988
773 "⦉⦊" ; U+2989 U+298A
774 "⦋⦌" ; U+298B U+298C
775 "⦍⦎" ; U+298D U+298E
776 "⦏⦐" ; U+298F U+2990
777 "⦑⦒" ; U+2991 U+2992
778 "⦓⦔" ; U+2993 U+2994
779 "⦕⦖" ; U+2995 U+2996
780 "⦗⦘" ; U+2997 U+2998
781 "⧼⧽" ; U+29FC U+29FD
782 "〈〉" ; U+3008 U+3009
783 "《》" ; U+300A U+300B
784 "「」" ; U+300C U+300D
785 "『』" ; U+300E U+300F
786 "【】" ; U+3010 U+3011
787 "〔〕" ; U+3014 U+3015
788 "〖〗" ; U+3016 U+3017
789 "〘〙" ; U+3018 U+3019
790 "〚〛" ; U+301A U+301B
791 "﴾﴿" ; U+FD3E U+FD3F
792 "︵︶" ; U+FE35 U+FE36
793 "︷︸" ; U+FE37 U+FE38
794 "︹︺" ; U+FE39 U+FE3A
795 "︻︼" ; U+FE3B U+FE3C
796 "︽︾" ; U+FE3D U+FE3E
797 "︿﹀" ; U+FE3F U+FE40
798 "﹁﹂" ; U+FE41 U+FE42
799 "﹃﹄" ; U+FE43 U+FE44
800 "﹙﹚" ; U+FE59 U+FE5A
801 "﹛﹜" ; U+FE5B U+FE5C
802 "﹝﹞" ; U+FE5D U+FE5E
803 "()" ; U+FF08 U+FF09
804 "[]" ; U+FF3B U+FF3D
805 "{}" ; U+FF5B U+FF5D
806 "⦅⦆" ; U+FF5F U+FF60
807 "「」" ; U+FF62 U+FF63
808 )))
809 (dolist (elt pairs)
810 (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
811 (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
812
813 \f
814 ;; For each character set, put the information of the most proper
815 ;; coding system to encode it by `preferred-coding-system' property.
816
817 ;; Fixme: should this be junked?
818 (let ((l '((latin-iso8859-1 . iso-latin-1)
819 (latin-iso8859-2 . iso-latin-2)
820 (latin-iso8859-3 . iso-latin-3)
821 (latin-iso8859-4 . iso-latin-4)
822 (thai-tis620 . thai-tis620)
823 (greek-iso8859-7 . greek-iso-8bit)
824 (arabic-iso8859-6 . iso-2022-7bit)
825 (hebrew-iso8859-8 . hebrew-iso-8bit)
826 (katakana-jisx0201 . japanese-shift-jis)
827 (latin-jisx0201 . japanese-shift-jis)
828 (cyrillic-iso8859-5 . cyrillic-iso-8bit)
829 (latin-iso8859-9 . iso-latin-5)
830 (japanese-jisx0208-1978 . iso-2022-jp)
831 (chinese-gb2312 . chinese-iso-8bit)
832 (chinese-gbk . chinese-gbk)
833 (gb18030-2-byte . chinese-gb18030)
834 (gb18030-4-byte-bmp . chinese-gb18030)
835 (gb18030-4-byte-smp . chinese-gb18030)
836 (gb18030-4-byte-ext-1 . chinese-gb18030)
837 (gb18030-4-byte-ext-2 . chinese-gb18030)
838 (japanese-jisx0208 . iso-2022-jp)
839 (korean-ksc5601 . iso-2022-kr)
840 (japanese-jisx0212 . iso-2022-jp)
841 (chinese-big5-1 . chinese-big5)
842 (chinese-big5-2 . chinese-big5)
843 (chinese-sisheng . iso-2022-7bit)
844 (ipa . iso-2022-7bit)
845 (vietnamese-viscii-lower . vietnamese-viscii)
846 (vietnamese-viscii-upper . vietnamese-viscii)
847 (arabic-digit . iso-2022-7bit)
848 (arabic-1-column . iso-2022-7bit)
849 (lao . lao)
850 (arabic-2-column . iso-2022-7bit)
851 (indian-is13194 . devanagari)
852 (indian-glyph . devanagari)
853 (tibetan-1-column . tibetan)
854 (ethiopic . iso-2022-7bit)
855 (chinese-cns11643-1 . iso-2022-cn)
856 (chinese-cns11643-2 . iso-2022-cn)
857 (chinese-cns11643-3 . iso-2022-cn)
858 (chinese-cns11643-4 . iso-2022-cn)
859 (chinese-cns11643-5 . iso-2022-cn)
860 (chinese-cns11643-6 . iso-2022-cn)
861 (chinese-cns11643-7 . iso-2022-cn)
862 (indian-2-column . devanagari)
863 (tibetan . tibetan)
864 (latin-iso8859-14 . iso-latin-8)
865 (latin-iso8859-15 . iso-latin-9))))
866 (while l
867 (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
868 (setq l (cdr l))))
869
870 \f
871 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
872 ;; SPACE and NEWLINE are already set.
873
874 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
875 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
876 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
877 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
878 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
879 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
880
881 \f
882 ;;; Setting char-width-table. The default is 1.
883
884 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
885 ;; and final characters.
886 (let ((l '((#x0300 . #x036F)
887 (#x0483 . #x0489)
888 (#x0591 . #x05BD)
889 (#x05BF . #x05BF)
890 (#x05C1 . #x05C2)
891 (#x05C4 . #x05C5)
892 (#x05C7 . #x05C7)
893 (#x0600 . #x0603)
894 (#x0610 . #x0615)
895 (#x064B . #x065E)
896 (#x0670 . #x0670)
897 (#x06D6 . #x06E4)
898 (#x06E7 . #x06E8)
899 (#x06EA . #x06ED)
900 (#x070F . #x070F)
901 (#x0711 . #x0711)
902 (#x0730 . #x074A)
903 (#x07A6 . #x07B0)
904 (#x07EB . #x07F3)
905 (#x0901 . #x0902)
906 (#x093C . #x093C)
907 (#x0941 . #x0948)
908 (#x094D . #x094D)
909 (#x0951 . #x0954)
910 (#x0962 . #x0963)
911 (#x0981 . #x0981)
912 (#x09BC . #x09BC)
913 (#x09C1 . #x09C4)
914 (#x09CD . #x09CD)
915 (#x09E2 . #x09E3)
916 (#x0A01 . #x0A02)
917 (#x0A3C . #x0A3C)
918 (#x0A41 . #x0A4D)
919 (#x0A70 . #x0A71)
920 (#x0A81 . #x0A82)
921 (#x0ABC . #x0ABC)
922 (#x0AC1 . #x0AC8)
923 (#x0ACD . #x0ACD)
924 (#x0AE2 . #x0AE3)
925 (#x0B01 . #x0B01)
926 (#x0B3C . #x0B3C)
927 (#x0B3F . #x0B3F)
928 (#x0B41 . #x0B43)
929 (#x0B4D . #x0B56)
930 (#x0B82 . #x0B82)
931 (#x0BC0 . #x0BC0)
932 (#x0BCD . #x0BCD)
933 (#x0C3E . #x0C40)
934 (#x0C46 . #x0C56)
935 (#x0CBC . #x0CBC)
936 (#x0CBF . #x0CBF)
937 (#x0CC6 . #x0CC6)
938 (#x0CCC . #x0CCD)
939 (#x0CE2 . #x0CE3)
940 (#x0D41 . #x0D43)
941 (#x0D4D . #x0D4D)
942 (#x0DCA . #x0DCA)
943 (#x0DD2 . #x0DD6)
944 (#x0E31 . #x0E31)
945 (#x0E34 . #x0E3A)
946 (#x0E47 . #x0E4E)
947 (#x0EB1 . #x0EB1)
948 (#x0EB4 . #x0EBC)
949 (#x0EC8 . #x0ECD)
950 (#x0F18 . #x0F19)
951 (#x0F35 . #x0F35)
952 (#x0F37 . #x0F37)
953 (#x0F39 . #x0F39)
954 (#x0F71 . #x0F7E)
955 (#x0F80 . #x0F84)
956 (#x0F86 . #x0F87)
957 (#x0F90 . #x0FBC)
958 (#x0FC6 . #x0FC6)
959 (#x102D . #x1030)
960 (#x1032 . #x1037)
961 (#x1039 . #x1039)
962 (#x1058 . #x1059)
963 (#x1160 . #x11FF)
964 (#x135F . #x135F)
965 (#x1712 . #x1714)
966 (#x1732 . #x1734)
967 (#x1752 . #x1753)
968 (#x1772 . #x1773)
969 (#x17B4 . #x17B5)
970 (#x17B7 . #x17BD)
971 (#x17C6 . #x17C6)
972 (#x17C9 . #x17D3)
973 (#x17DD . #x17DD)
974 (#x180B . #x180D)
975 (#x18A9 . #x18A9)
976 (#x1920 . #x1922)
977 (#x1927 . #x1928)
978 (#x1932 . #x1932)
979 (#x1939 . #x193B)
980 (#x1A17 . #x1A18)
981 (#x1B00 . #x1B03)
982 (#x1B34 . #x1B34)
983 (#x1B36 . #x1B3A)
984 (#x1B3C . #x1B3C)
985 (#x1B42 . #x1B42)
986 (#x1B6B . #x1B73)
987 (#x1DC0 . #x1DFF)
988 (#x200B . #x200F)
989 (#x202A . #x202E)
990 (#x2060 . #x206F)
991 (#x20D0 . #x20EF)
992 (#x302A . #x302F)
993 (#x3099 . #x309A)
994 (#xA806 . #xA806)
995 (#xA80B . #xA80B)
996 (#xA825 . #xA826)
997 (#xFB1E . #xFB1E)
998 (#xFE00 . #xFE0F)
999 (#xFE20 . #xFE23)
1000 (#xFEFF . #xFEFF)
1001 (#xFFF9 . #xFFFB)
1002 (#x10A01 . #x10A0F)
1003 (#x10A38 . #x10A3F)
1004 (#x1D167 . #x1D169)
1005 (#x1D173 . #x1D182)
1006 (#x1D185 . #x1D18B)
1007 (#x1D1AA . #x1D1AD)
1008 (#x1D242 . #x1D244)
1009 (#xE0001 . #xE01EF))))
1010 (dolist (elt l)
1011 (set-char-table-range char-width-table elt 0)))
1012
1013 ;; 2: East Asian Wide and Full-width characters.
1014 (let ((l '((#x1100 . #x115F)
1015 (#x2329 . #x232A)
1016 (#x2E80 . #x303E)
1017 (#x3040 . #xA4CF)
1018 (#xAC00 . #xD7A3)
1019 (#xF900 . #xFAFF)
1020 (#xFE30 . #xFE6F)
1021 (#xFF01 . #xFF60)
1022 (#xFFE0 . #xFFE6)
1023 (#x20000 . #x2FFFF)
1024 (#x30000 . #x3FFFF))))
1025 (dolist (elt l)
1026 (set-char-table-range char-width-table elt 2)))
1027
1028 ;; Other double width
1029 ;;(map-charset-chars
1030 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1031 ;; 'ethiopic)
1032 ;; (map-charset-chars
1033 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1034 ;; 'tibetan)
1035 (map-charset-chars
1036 (lambda (range ignore) (set-char-table-range char-width-table range 2))
1037 'indian-2-column)
1038 (map-charset-chars
1039 (lambda (range ignore) (set-char-table-range char-width-table range 2))
1040 'arabic-2-column)
1041
1042 ;; Internal use only.
1043 ;; Alist of locale symbol vs charsets. In a language environment
1044 ;; corresponding to the locale, width of characters in the charsets is
1045 ;; set to 2. Each element has the form:
1046 ;; (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1047 ;; LOCALE: locale symbol
1048 ;; TABLE: char-table used for char-width-table, initially nil.
1049 ;; CAHRSET: character set
1050 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1051
1052 (defvar cjk-char-width-table-list
1053 '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1054 (cp932-2-byte (#x8140 . #x879F)))
1055 (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1056 (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1057 (zh_TW nil (big5 (#xA140 . #xA3FE))
1058 (chinese-cns11643-1 (#x2121 . #x427E)))
1059 (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1060
1061 ;; Internal use only.
1062 ;; Setup char-width-table appropriate for a language environment
1063 ;; corresponding to LOCALE-NAME (symbol).
1064
1065 (defun use-cjk-char-width-table (locale-name)
1066 (while (char-table-parent char-width-table)
1067 (setq char-width-table (char-table-parent char-width-table)))
1068 (let ((slot (assq locale-name cjk-char-width-table-list))
1069 table)
1070 (or slot (error "Unknown locale for CJK language environment: %s"
1071 locale-name))
1072 (unless (nth 1 slot)
1073 (let ((table (make-char-table nil)))
1074 (dolist (charset-info (nthcdr 2 slot))
1075 (let ((charset (car charset-info)))
1076 (dolist (code-range (cdr charset-info))
1077 (map-charset-chars #'(lambda (range arg)
1078 (set-char-table-range table range 2))
1079 charset nil
1080 (car code-range) (cdr code-range)))))
1081 (optimize-char-table table)
1082 (set-char-table-parent table char-width-table)
1083 (setcar (cdr slot) table)))
1084 (setq char-width-table (nth 1 slot))))
1085
1086 (defun use-default-char-width-table ()
1087 "Internal use only.
1088 Setup char-width-table appropriate for non-CJK language environment."
1089 (while (char-table-parent char-width-table)
1090 (setq char-width-table (char-table-parent char-width-table))))
1091
1092 (optimize-char-table (standard-case-table))
1093 (optimize-char-table (standard-syntax-table))
1094
1095 \f
1096 ;; Setting char-script-table.
1097
1098 ;; The Unicode blocks actually extend past some of these ranges with
1099 ;; undefined codepoints.
1100 (let ((script-list nil))
1101 (dolist
1102 (elt
1103 '((#x0000 #x007F latin)
1104 (#x00A0 #x024F latin)
1105 (#x0250 #x02AF phonetic)
1106 (#x02B0 #x036F latin)
1107 (#x0370 #x03E1 greek)
1108 (#x03E2 #x03EF coptic)
1109 (#x03F0 #x03F3 greek)
1110 (#x0400 #x04FF cyrillic)
1111 (#x0530 #x058F armenian)
1112 (#x0590 #x05FF hebrew)
1113 (#x0600 #x06FF arabic)
1114 (#x0700 #x074F syriac)
1115 (#x07C0 #x07FA nko)
1116 (#x0780 #x07BF thaana)
1117 (#x0900 #x097F devanagari)
1118 (#x0980 #x09FF bengali)
1119 (#x0A00 #x0A7F gurmukhi)
1120 (#x0A80 #x0AFF gujarati)
1121 (#x0B00 #x0B7F oriya)
1122 (#x0B80 #x0BFF tamil)
1123 (#x0C00 #x0C7F telugu)
1124 (#x0C80 #x0CFF kannada)
1125 (#x0D00 #x0D7F malayalam)
1126 (#x0D80 #x0DFF sinhala)
1127 (#x0E00 #x0E5F thai)
1128 (#x0E80 #x0EDF lao)
1129 (#x0F00 #x0FFF tibetan)
1130 (#x1000 #x109F burmese)
1131 (#x10A0 #x10FF georgian)
1132 (#x1100 #x11FF hangul)
1133 (#x1200 #x139F ethiopic)
1134 (#x13A0 #x13FF cherokee)
1135 (#x1400 #x167F canadian-aboriginal)
1136 (#x1680 #x169F ogham)
1137 (#x16A0 #x16FF runic)
1138 (#x1780 #x17FF khmer)
1139 (#x1800 #x18AF mongolian)
1140 (#x1D00 #x1DFF phonetic)
1141 (#x1E00 #x1EFF latin)
1142 (#x1F00 #x1FFF greek)
1143 (#x2000 #x27FF symbol)
1144 (#x2800 #x28FF braille)
1145 (#x2D80 #x2DDF ethiopic)
1146 (#x2E80 #x2FDF han)
1147 (#x2FF0 #x2FFF ideographic-description)
1148 (#x3000 #x303F cjk-misc)
1149 (#x3040 #x30FF kana)
1150 (#x3100 #x312F bopomofo)
1151 (#x3130 #x318F hangul)
1152 (#x3190 #x319F kanbun)
1153 (#x31A0 #x31BF bopomofo)
1154 (#x3400 #x9FAF han)
1155 (#xA000 #xA4CF yi)
1156 (#xAA00 #xAA5F cham)
1157 (#xAA60 #xAA7B burmese)
1158 (#xAA80 #xAADF tai-viet)
1159 (#xAC00 #xD7AF hangul)
1160 (#xF900 #xFAFF han)
1161 (#xFB1D #xFB4F hebrew)
1162 (#xFB50 #xFDFF arabic)
1163 (#xFE70 #xFEFC arabic)
1164 (#xFF00 #xFF5F cjk-misc)
1165 (#xFF61 #xFF9F kana)
1166 (#xFFE0 #xFFE6 cjk-misc)
1167 (#x10000 #x100FF linear-b)
1168 (#x10100 #x1013F aegean-number)
1169 (#x10140 #x1018A ancient-greek-number)
1170 (#x10190 #x1019B ancient-symbol)
1171 (#x101D0 #x101FF phaistos-disc)
1172 (#x10280 #x1029F lycian)
1173 (#x102A0 #x102DF carian)
1174 (#x10300 #x1032F olt-italic)
1175 (#x10380 #x1039F ugaritic)
1176 (#x103A0 #x103DF old-persian)
1177 (#x10400 #x1044F deseret)
1178 (#x10450 #x1047F shavian)
1179 (#x10480 #x104AF osmanya)
1180 (#x10800 #x1083F cypriot-syllabary)
1181 (#x10900 #x1091F phoenician)
1182 (#x10920 #x1093F lydian)
1183 (#x10A00 #x10A5F kharoshthi)
1184 (#x12000 #x123FF cuneiform)
1185 (#x12400 #x1247F cuneiform-numbers-and-punctuation)
1186 (#x1D000 #x1D0FF byzantine-musical-symbol)
1187 (#x1D100 #x1D1FF musical-symbol)
1188 (#x1D200 #x1D24F ancient-greek-musical-notation)
1189 (#x1D300 #x1D35F tai-xuan-jing-symbol)
1190 (#x1D360 #x1D37F counting-rod-numeral)
1191 (#x1D400 #x1D7FF mathematical)
1192 (#x1F000 #x1F02F mahjong-tile)
1193 (#x1F030 #x1F09F domino-tile)
1194 (#x20000 #x2AFFF han)
1195 (#x2F800 #x2FFFF han)))
1196 (set-char-table-range char-script-table
1197 (cons (car elt) (nth 1 elt)) (nth 2 elt))
1198 (or (memq (nth 2 elt) script-list)
1199 (setq script-list (cons (nth 2 elt) script-list))))
1200 (set-char-table-extra-slot char-script-table 0 (nreverse script-list)))
1201
1202 (map-charset-chars
1203 #'(lambda (range ignore)
1204 (set-char-table-range char-script-table range 'tibetan))
1205 'tibetan)
1206
1207 \f
1208 ;;; Setting unicode-category-table.
1209
1210 ;; This macro is to build unicode-category-table at compile time so
1211 ;; that C code can access the table efficiently.
1212 (defmacro build-unicode-category-table ()
1213 (let ((table (make-char-table 'unicode-category-table nil)))
1214 (dotimes (i #x110000)
1215 (if (or (< i #xD800)
1216 (and (>= i #xF900) (< i #x30000))
1217 (and (>= i #xE0000) (< i #xE0200)))
1218 (aset table i (get-char-code-property i 'general-category))))
1219 (set-char-table-range table '(#xE000 . #xF8FF) 'Co)
1220 (set-char-table-range table '(#xF0000 . #xFFFFD) 'Co)
1221 (set-char-table-range table '(#x100000 . #x10FFFD) 'Co)
1222 (optimize-char-table table 'eq)
1223 table))
1224
1225 (setq unicode-category-table (build-unicode-category-table))
1226 (map-char-table #'(lambda (key val)
1227 (if (and val
1228 (or (and (/= (aref (symbol-name val) 0) ?M)
1229 (/= (aref (symbol-name val) 0) ?C))
1230 (eq val 'Zs)))
1231 (modify-category-entry key ?.)))
1232 unicode-category-table)
1233
1234 (optimize-char-table (standard-category-table))
1235
1236 \f
1237 ;;; Setting word boundary.
1238
1239 (setq word-combining-categories
1240 '((nil . ?^)
1241 (?^ . nil)
1242 (?C . ?H)
1243 (?C . ?K)))
1244
1245 (setq word-separating-categories ; (2-byte character sets)
1246 '((?H . ?K) ; Hiragana - Katakana
1247 ))
1248
1249 ;; Local Variables:
1250 ;; coding: utf-8
1251 ;; End:
1252
1253 ;; arch-tag: 85889c35-9f4d-4912-9bf5-82de31b0d42d
1254 ;;; characters.el ends here