]> code.delx.au - gnu-emacs/blob - lisp/international/characters.el
Fix bug #11209 with case conversion of u+0178.
[gnu-emacs] / lisp / international / characters.el
1 ;;; characters.el --- set syntax and category for multibyte characters
2
3 ;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
6 ;; National Institute of Advanced Industrial Science and Technology (AIST)
7 ;; Registration Number H14PRO021
8 ;; Copyright (C) 2003
9 ;; National Institute of Advanced Industrial Science and Technology (AIST)
10 ;; Registration Number H13PRO009
11
12 ;; Keywords: multibyte character, character set, syntax, category
13
14 ;; This file is part of GNU Emacs.
15
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
20
21 ;; GNU Emacs is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
25
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29 ;;; Commentary:
30
31 ;;; Code:
32
33 ;;; Predefined categories.
34
35 ;; For each character set.
36
37 (define-category ?a "ASCII
38 ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])")
39 (define-category ?l "Latin")
40 (define-category ?t "Thai")
41 (define-category ?g "Greek")
42 (define-category ?b "Arabic")
43 (define-category ?w "Hebrew")
44 (define-category ?y "Cyrillic")
45 (define-category ?k "Katakana
46 Japanese katakana")
47 (define-category ?r "Roman
48 Japanese roman")
49 (define-category ?c "Chinese")
50 (define-category ?j "Japanese")
51 (define-category ?h "Korean")
52 (define-category ?e "Ethiopic
53 Ethiopic (Ge'ez)")
54 (define-category ?v "Viet
55 Vietnamese")
56 (define-category ?i "Indian")
57 (define-category ?o "Lao")
58 (define-category ?q "Tibetan")
59
60 ;; For each group (row) of 2-byte character sets.
61
62 (define-category ?A "2-byte alnum
63 Alpha-numeric characters of 2-byte character sets")
64 (define-category ?C "2-byte han
65 Chinese (Han) characters of 2-byte character sets")
66 (define-category ?G "2-byte Greek
67 Greek characters of 2-byte character sets")
68 (define-category ?H "2-byte Hiragana
69 Japanese Hiragana characters of 2-byte character sets")
70 (define-category ?K "2-byte Katakana
71 Japanese Katakana characters of 2-byte character sets")
72 (define-category ?N "2-byte Korean
73 Korean Hangul characters of 2-byte character sets")
74 (define-category ?Y "2-byte Cyrillic
75 Cyrillic characters of 2-byte character sets")
76 (define-category ?I "Indian Glyphs")
77
78 ;; For phonetic classifications.
79
80 (define-category ?0 "consonant")
81 (define-category ?1 "base vowel
82 Base (independent) vowel")
83 (define-category ?2 "upper diacritic
84 Upper diacritical mark (including upper vowel)")
85 (define-category ?3 "lower diacritic
86 Lower diacritical mark (including lower vowel)")
87 (define-category ?4 "combining tone
88 Combining tone mark")
89 (define-category ?5 "symbol")
90 (define-category ?6 "digit")
91 (define-category ?7 "vowel diacritic
92 Vowel-modifying diacritical mark")
93 (define-category ?8 "vowel-signs")
94 (define-category ?9 "semivowel lower")
95
96 ;; For filling.
97 (define-category ?| "line breakable
98 While filling, we can break a line at this character.")
99
100 ;; For indentation calculation.
101 (define-category ?\s
102 "space for indent
103 This character counts as a space for indentation purposes.")
104
105 ;; Keep the following for `kinsoku' processing. See comments in
106 ;; kinsoku.el.
107 (define-category ?> "Not at bol
108 A character which can't be placed at beginning of line.")
109 (define-category ?< "Not at eol
110 A character which can't be placed at end of line.")
111
112 ;; Base and Combining
113 (define-category ?. "Base
114 Base characters (Unicode General Category L,N,P,S,Zs)")
115 (define-category ?^ "Combining
116 Combining diacritic or mark (Unicode General Category M)")
117
118 ;; bidi types
119 (define-category ?R "Right-to-left (strong)
120 Characters with \"strong\" right-to-left directionality, i.e.
121 with R, AL, RLE, or RLO Unicode bidi character type.")
122
123 (define-category ?L "Left-to-right (strong)
124 Characters with \"strong\" left-to-right directionality, i.e.
125 with L, LRE, or LRO Unicode bidi character type.")
126
127 \f
128 ;;; Setting syntax and category.
129
130 ;; ASCII
131
132 ;; All ASCII characters have the category `a' (ASCII) and `l' (Latin).
133 (modify-category-entry '(32 . 127) ?a)
134 (modify-category-entry '(32 . 127) ?l)
135
136 ;; Deal with the CJK charsets first. Since the syntax of blocks is
137 ;; defined per charset, and the charsets may contain e.g. Latin
138 ;; characters, we end up with the wrong syntax definitions if we're
139 ;; not careful.
140
141 ;; Chinese characters (Unicode)
142 (modify-category-entry '(#x2E80 . #x312F) ?|)
143 (modify-category-entry '(#x3190 . #x33FF) ?|)
144 (modify-category-entry '(#x3400 . #x4DBF) ?C)
145 (modify-category-entry '(#x4E00 . #x9FAF) ?C)
146 (modify-category-entry '(#x3400 . #x9FAF) ?c)
147 (modify-category-entry '(#x3400 . #x9FAF) ?|)
148 (modify-category-entry '(#xF900 . #xFAFF) ?C)
149 (modify-category-entry '(#xF900 . #xFAFF) ?c)
150 (modify-category-entry '(#xF900 . #xFAFF) ?|)
151 (modify-category-entry '(#x20000 . #x2FFFF) ?|)
152 (modify-category-entry '(#x20000 . #x2FFFF) ?C)
153 (modify-category-entry '(#x20000 . #x2FFFF) ?c)
154
155
156 ;; Chinese character set (GB2312)
157
158 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2121 #x217E)
159 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2221 #x227E)
160 (map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2921 #x297E)
161
162 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?c)
163 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2330 #x2339)
164 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2341 #x235A)
165 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2361 #x237A)
166 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?H #x2421 #x247E)
167 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?K #x2521 #x257E)
168 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?G #x2621 #x267E)
169 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?Y #x2721 #x277E)
170 (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?C #x3021 #x7E7E)
171
172 ;; Chinese character set (BIG5)
173
174 (map-charset-chars #'modify-category-entry 'big5 ?c)
175 (map-charset-chars #'modify-category-entry 'big5 ?C #xA259 #xA261)
176 (map-charset-chars #'modify-category-entry 'big5 ?C #xA440 #xC67E)
177 (map-charset-chars #'modify-category-entry 'big5 ?C #xC940 #xF9DC)
178
179 ;; Chinese character set (CNS11643)
180
181 (dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
182 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
183 chinese-cns11643-7))
184 (map-charset-chars #'modify-category-entry c ?c)
185 (if (eq c 'chinese-cns11643-1)
186 (map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E)
187 (map-charset-chars #'modify-category-entry c ?C)))
188
189 ;; Japanese character set (JISX0201, JISX0208, JISX0212, JISX0213)
190
191 (map-charset-chars #'modify-category-entry 'katakana-jisx0201 ?k)
192
193 (map-charset-chars #'modify-category-entry 'latin-jisx0201 ?r)
194
195 (dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212
196 japanese-jisx0213-1 japanese-jisx0213-2
197 cp932-2-byte))
198 (map-charset-chars #'modify-category-entry l ?j))
199
200 ;; Fullwidth characters
201 (modify-category-entry '(#xff01 . #xff60) ?\|)
202
203 ;; Unicode equivalents of JISX0201-kana
204 (let ((range '(#xff61 . #xff9f)))
205 (modify-category-entry range ?k)
206 (modify-category-entry range ?j)
207 (modify-category-entry range ?\|))
208
209 ;; Katakana block
210 (modify-category-entry '(#x3099 . #x309C) ?K)
211 (modify-category-entry '(#x30A0 . #x30FF) ?K)
212 (modify-category-entry '(#x31F0 . #x31FF) ?K)
213 (modify-category-entry '(#x30A0 . #x30FA) ?\|)
214 (modify-category-entry #x30FF ?\|)
215
216 ;; Hiragana block
217 (modify-category-entry '(#x3040 . #x309F) ?H)
218 (modify-category-entry '(#x3040 . #x3096) ?\|)
219 (modify-category-entry #x309F ?\|)
220 (modify-category-entry #x30A0 ?H)
221 (modify-category-entry #x30FC ?H)
222
223
224 ;; JISX0208
225 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
226 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
227 (let ((chars '(?ー ?゛ ?゜ ?ヽ ?ヾ ?ゝ ?ゞ ?〃 ?仝 ?々 ?〆 ?〇)))
228 (dolist (elt chars)
229 (modify-syntax-entry (car chars) "w")))
230
231 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?A #x2321 #x237E)
232 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?H #x2421 #x247E)
233 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?K #x2521 #x257E)
234 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?G #x2621 #x267E)
235 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?Y #x2721 #x277E)
236 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?C #x3021 #x7E7E)
237 (modify-category-entry ?ー ?K)
238 (let ((chars '(?゛ ?゜)))
239 (while chars
240 (modify-category-entry (car chars) ?K)
241 (modify-category-entry (car chars) ?H)
242 (setq chars (cdr chars))))
243 (let ((chars '(?仝 ?々 ?〆 ?〇)))
244 (while chars
245 (modify-category-entry (car chars) ?C)
246 (setq chars (cdr chars))))
247
248 ;; JISX0212
249
250 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0212 "_" #x2121 #x237E)
251
252 ;; JISX0201-Kana
253
254 (let ((chars '(?。 ?、 ?・)))
255 (while chars
256 (modify-syntax-entry (car chars) ".")
257 (setq chars (cdr chars))))
258
259 (modify-syntax-entry ?\「 "(」")
260 (modify-syntax-entry ?\」 "(「")
261
262 ;; Korean character set (KSC5601)
263
264 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?h)
265
266 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
267 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
268 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
269 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
270 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
271 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
272 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
273 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?G #x2521 #x257E)
274 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?H #x2A21 #x2A7E)
275 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?K #x2B21 #x2B7E)
276 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?Y #x2C21 #x2C7E)
277
278 ;; These are in more than one charset.
279 (let ((parens (concat "〈〉《》「」『』【】〔〕〖〗〘〙〚〛"
280 "︵︶︷︸︹︺︻︼︽︾︿﹀﹁﹂﹃﹄"
281 "()[]{}"))
282 open close)
283 (dotimes (i (/ (length parens) 2))
284 (setq open (aref parens (* i 2))
285 close (aref parens (1+ (* i 2))))
286 (modify-syntax-entry open (format "(%c" close))
287 (modify-syntax-entry close (format ")%c" open))))
288
289 ;; Arabic character set
290
291 (let ((charsets '(arabic-iso8859-6
292 arabic-digit
293 arabic-1-column
294 arabic-2-column)))
295 (while charsets
296 (map-charset-chars #'modify-category-entry (car charsets) ?b)
297 (setq charsets (cdr charsets))))
298 (modify-category-entry '(#x600 . #x6ff) ?b)
299 (modify-category-entry '(#xfb50 . #xfdff) ?b)
300 (modify-category-entry '(#xfe70 . #xfefe) ?b)
301
302 ;; Cyrillic character set (ISO-8859-5)
303
304 (modify-syntax-entry ?№ ".")
305
306 ;; Ethiopic character set
307
308 (modify-category-entry '(#x1200 . #x1399) ?e)
309 (modify-category-entry '(#x2d80 . #x2dde) ?e)
310 (let ((chars '(?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨)))
311 (while chars
312 (modify-syntax-entry (car chars) ".")
313 (setq chars (cdr chars))))
314 (map-charset-chars #'modify-category-entry 'ethiopic ?e)
315
316 ;; Hebrew character set (ISO-8859-8)
317
318 (modify-syntax-entry #x5be ".") ; MAQAF
319 (modify-syntax-entry #x5c0 ".") ; PASEQ
320 (modify-syntax-entry #x5c3 ".") ; SOF PASUQ
321 (modify-syntax-entry #x5f3 ".") ; GERESH
322 (modify-syntax-entry #x5f4 ".") ; GERSHAYIM
323
324 ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
325
326 (modify-category-entry '(#x901 . #x970) ?i)
327 (map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
328 (map-charset-chars #'modify-category-entry 'indian-2-column ?i)
329
330 ;; Lao character set
331
332 (modify-category-entry '(#xe80 . #xeff) ?o)
333 (map-charset-chars #'modify-category-entry 'lao ?o)
334
335 (let ((deflist '(("ກ-ຮ" "w" ?0) ; consonant
336 ("ະາຳຽເ-ໄ" "w" ?1) ; vowel base
337 ("ັິ-ືົໍ" "w" ?2) ; vowel upper
338 ("ຸູ" "w" ?3) ; vowel lower
339 ("່-໋" "w" ?4) ; tone mark
340 ("ຼຽ" "w" ?9) ; semivowel lower
341 ("໐-໙" "w" ?6) ; digit
342 ("ຯໆ" "_" ?5) ; symbol
343 ))
344 elm chars len syntax category to ch i)
345 (while deflist
346 (setq elm (car deflist))
347 (setq chars (car elm)
348 len (length chars)
349 syntax (nth 1 elm)
350 category (nth 2 elm)
351 i 0)
352 (while (< i len)
353 (if (= (aref chars i) ?-)
354 (setq i (1+ i)
355 to (aref chars i))
356 (setq ch (aref chars i)
357 to ch))
358 (while (<= ch to)
359 (unless (string-equal syntax "w")
360 (modify-syntax-entry ch syntax))
361 (modify-category-entry ch category)
362 (setq ch (1+ ch)))
363 (setq i (1+ i)))
364 (setq deflist (cdr deflist))))
365
366 ;; Thai character set (TIS620)
367
368 (modify-category-entry '(#xe00 . #xe7f) ?t)
369 (map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
370
371 (let ((deflist '(;; chars syntax category
372 ("ก-รลว-ฮ" "w" ?0) ; consonant
373 ("ฤฦะาำเ-ๅ" "w" ?1) ; vowel base
374 ("ัิ-ื็๎" "w" ?2) ; vowel upper
375 ("ุ-ฺ" "w" ?3) ; vowel lower
376 ("่-ํ" "w" ?4) ; tone mark
377 ("๐-๙" "w" ?6) ; digit
378 ("ฯๆ฿๏๚๛" "_" ?5) ; symbol
379 ))
380 elm chars len syntax category to ch i)
381 (while deflist
382 (setq elm (car deflist))
383 (setq chars (car elm)
384 len (length chars)
385 syntax (nth 1 elm)
386 category (nth 2 elm)
387 i 0)
388 (while (< i len)
389 (if (= (aref chars i) ?-)
390 (setq i (1+ i)
391 to (aref chars i))
392 (setq ch (aref chars i)
393 to ch))
394 (while (<= ch to)
395 (unless (string-equal syntax "w")
396 (modify-syntax-entry ch syntax))
397 (modify-category-entry ch category)
398 (setq ch (1+ ch)))
399 (setq i (1+ i)))
400 (setq deflist (cdr deflist))))
401
402 ;; Tibetan character set
403
404 (modify-category-entry '(#xf00 . #xfff) ?q)
405 (map-charset-chars #'modify-category-entry 'tibetan ?q)
406 (map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
407
408 (let ((deflist '(;; chars syntax category
409 ("ཀ-ཀྵཪ" "w" ?0) ; consonant
410 ("ྐ-ྐྵྺྻྼ" "w" ?0) ;
411 ("ིེཻོཽྀ" "w" ?2) ; upper vowel
412 ("ཾྂྃ྆྇ྈྉྊྋ" "w" ?2) ; upper modifier
413 ("྄ཱུ༙༵༷" "w" ?3) ; lower vowel/modifier
414 ("཰" "w" ?3) ; invisible vowel a
415 ("༠-༩༪-༳" "w" ?6) ; digit
416 ("་།-༒༔ཿ" "." ?|) ; line-break char
417 ("་།༏༐༑༔ཿ" "." ?|) ;
418 ("༈་།-༒༔ཿ༽༴" "." ?>) ; prohibition
419 ("་།༏༐༑༔ཿ" "." ?>) ;
420 ("ༀ-༊༼࿁࿂྅" "." ?<) ; prohibition
421 ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
422 ))
423 elm chars len syntax category to ch i)
424 (while deflist
425 (setq elm (car deflist))
426 (setq chars (car elm)
427 len (length chars)
428 syntax (nth 1 elm)
429 category (nth 2 elm)
430 i 0)
431 (while (< i len)
432 (if (= (aref chars i) ?-)
433 (setq i (1+ i)
434 to (aref chars i))
435 (setq ch (aref chars i)
436 to ch))
437 (while (<= ch to)
438 (unless (string-equal syntax "w")
439 (modify-syntax-entry ch syntax))
440 (modify-category-entry ch category)
441 (setq ch (1+ ch)))
442 (setq i (1+ i)))
443 (setq deflist (cdr deflist))))
444
445 ;; Vietnamese character set
446
447 ;; To make a word with Latin characters
448 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
449 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
450
451 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
452 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
453
454 (let ((tbl (standard-case-table))
455 (i 32))
456 (while (< i 128)
457 (let* ((char (decode-char 'vietnamese-viscii-upper i))
458 (charl (decode-char 'vietnamese-viscii-lower i))
459 (uc (encode-char char 'ucs))
460 (lc (encode-char charl 'ucs)))
461 (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
462 tbl)
463 (if uc (modify-category-entry uc ?v))
464 (if lc (modify-category-entry lc ?v)))
465 (setq i (1+ i))))
466
467 ;; Tai Viet
468 (let ((deflist '(;; chars syntax category
469 ((?ꪀ. ?ꪯ) "w" ?0) ; consonant
470 ("ꪱꪵꪶ" "w" ?1) ; vowel base
471 ((?ꪹ . ?ꪽ) "w" ?1) ; vowel base
472 ("ꪰꪲꪳꪷꪸꪾ" "w" ?2) ; vowel upper
473 ("ꪴ" "w" ?3) ; vowel lower
474 ("ꫀꫂ" "w" ?1) ; non-combining tone-mark
475 ("꪿꫁" "w" ?4) ; combining tone-mark
476 ((?ꫛ . ?꫟) "_" ?5) ; symbol
477 )))
478 (dolist (elm deflist)
479 (let ((chars (car elm))
480 (syntax (nth 1 elm))
481 (category (nth 2 elm)))
482 (if (consp chars)
483 (progn
484 (modify-syntax-entry chars syntax)
485 (modify-category-entry chars category))
486 (mapc #'(lambda (x)
487 (modify-syntax-entry x syntax)
488 (modify-category-entry x category))
489 chars)))))
490
491 ;; Bidi categories
492
493 (map-char-table (lambda (key val)
494 (cond
495 ((memq val '(R AL RLO RLE))
496 (modify-category-entry key ?R))
497 ((memq val '(L LRE LRO))
498 (modify-category-entry key ?L))))
499 (unicode-property-table-internal 'bidi-class))
500
501 ;; Latin
502
503 (modify-category-entry '(#x80 . #x024F) ?l)
504
505 (let ((tbl (standard-case-table)) c)
506
507 ;; Latin-1
508
509 ;; Fixme: Some of the non-word syntaxes here perhaps should be
510 ;; reviewed. (Note that the following all implicitly have word
511 ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
512 ;; relating Unicode categories to Emacs syntax codes.
513
514 ;; NBSP isn't semantically interchangeable with other whitespace chars,
515 ;; so it's more like punctuation.
516 (set-case-syntax ?  "." tbl)
517 (set-case-syntax ?¡ "." tbl)
518 (set-case-syntax ?¦ "_" tbl)
519 (set-case-syntax ?§ "." tbl)
520 (set-case-syntax ?© "_" tbl)
521 (set-case-syntax-delims 171 187 tbl) ; « »
522 (set-case-syntax ?¬ "_" tbl)
523 (set-case-syntax ?­ "_" tbl)
524 (set-case-syntax ?® "_" tbl)
525 (set-case-syntax ?° "_" tbl)
526 (set-case-syntax ?± "_" tbl)
527 (set-case-syntax ?µ "_" tbl)
528 (set-case-syntax ?· "_" tbl)
529 (set-case-syntax ?¼ "_" tbl)
530 (set-case-syntax ?½ "_" tbl)
531 (set-case-syntax ?¾ "_" tbl)
532 (set-case-syntax ?¿ "." tbl)
533 (let ((c 192))
534 (while (<= c 222)
535 (set-case-syntax-pair c (+ c 32) tbl)
536 (setq c (1+ c))))
537 (set-case-syntax ?× "_" tbl)
538 (set-case-syntax ?ß "w" tbl)
539 (set-case-syntax ?÷ "_" tbl)
540 ;; See below for ÿ.
541
542 ;; Latin Extended-A, Latin Extended-B
543 (setq c #x0100)
544 (while (<= c #x02B8)
545 (modify-category-entry c ?l)
546 (setq c (1+ c)))
547
548 (let ((pair-ranges '((#x0100 . #x012F)
549 (#x0132 . #x0137)
550 (#x0139 . #x0148)
551 (#x014a . #x0177)
552 (#x0179 . #x017E)
553 (#x0182 . #x0185)
554 (#x0187 . #x0188)
555 (#x018B . #x018C)
556 (#x0191 . #x0192)
557 (#x0198 . #x0199)
558 (#x01A0 . #x01A5)
559 (#x01A7 . #x01A8)
560 (#x01AC . #x01AD)
561 (#x01AF . #x01B0)
562 (#x01B3 . #x01B6)
563 (#x01BC . #x01BD)
564 (#x01CD . #x01DC)
565 (#x01DE . #x01EF)
566 (#x01F4 . #x01F5)
567 (#x01F8 . #x021F)
568 (#x0222 . #x0233)
569 (#x023B . #x023C)
570 (#x0241 . #x0242)
571 (#x0246 . #x024F))))
572 (dolist (elt pair-ranges)
573 (let ((from (car elt)) (to (cdr elt)))
574 (while (< from to)
575 (set-case-syntax-pair from (1+ from) tbl)
576 (setq from (+ from 2))))))
577
578 (set-case-syntax-pair #x178 #x0ff tbl)
579 (set-case-syntax-pair #x189 #x256 tbl)
580 (set-case-syntax-pair #x18A #x257 tbl)
581
582 ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
583 ;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
584 ;; do U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN
585 ;; SMALL LETTER I.
586
587 ;; We used to set up half of those correspondence unconditionally,
588 ;; but that makes searches slow. So now we don't set up either half
589 ;; of these correspondences by default.
590
591 ;; (set-downcase-syntax ?İ ?i tbl)
592 ;; (set-upcase-syntax ?I ?ı tbl)
593
594 (set-case-syntax-pair ?DŽ ?dž tbl)
595 (set-case-syntax-pair ?Dž ?dž tbl)
596 (set-case-syntax-pair ?LJ ?lj tbl)
597 (set-case-syntax-pair ?Lj ?lj tbl)
598 (set-case-syntax-pair ?NJ ?nj tbl)
599 (set-case-syntax-pair ?Nj ?nj tbl)
600
601 ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
602 (set-case-syntax-pair ?DZ ?dz tbl)
603 (set-case-syntax-pair ?Dz ?dz tbl)
604 (set-case-syntax-pair ?Ƕ ?ƕ tbl)
605 (set-case-syntax-pair ?Ƿ ?ƿ tbl)
606
607 ;; Latin Extended Additional
608 (modify-category-entry '(#x1e00 . #x1ef9) ?l)
609 (setq c #x1e00)
610 (while (<= c #x1ef9)
611 (and (zerop (% c 2))
612 (or (<= c #x1e94) (>= c #x1ea0))
613 (set-case-syntax-pair c (1+ c) tbl))
614 (setq c (1+ c)))
615
616 ;; Greek
617 (modify-category-entry '(#x0370 . #x03ff) ?g)
618 (setq c #x0370)
619 (while (<= c #x03ff)
620 (if (or (and (>= c #x0391) (<= c #x03a1))
621 (and (>= c #x03a3) (<= c #x03ab)))
622 (set-case-syntax-pair c (+ c 32) tbl))
623 (and (>= c #x03da)
624 (<= c #x03ee)
625 (zerop (% c 2))
626 (set-case-syntax-pair c (1+ c) tbl))
627 (setq c (1+ c)))
628 (set-case-syntax-pair ?Ά ?ά tbl)
629 (set-case-syntax-pair ?Έ ?έ tbl)
630 (set-case-syntax-pair ?Ή ?ή tbl)
631 (set-case-syntax-pair ?Ί ?ί tbl)
632 (set-case-syntax-pair ?Ό ?ό tbl)
633 (set-case-syntax-pair ?Ύ ?ύ tbl)
634 (set-case-syntax-pair ?Ώ ?ώ tbl)
635
636 ;; Armenian
637 (setq c #x531)
638 (while (<= c #x556)
639 (set-case-syntax-pair c (+ c #x30) tbl)
640 (setq c (1+ c)))
641
642 ;; Greek Extended
643 (modify-category-entry '(#x1f00 . #x1fff) ?g)
644 (setq c #x1f00)
645 (while (<= c #x1fff)
646 (and (<= (logand c #x000f) 7)
647 (<= c #x1fa7)
648 (not (memq c '(#x1f16 #x1f17 #x1f56 #x1f57
649 #x1f50 #x1f52 #x1f54 #x1f56)))
650 (/= (logand c #x00f0) #x70)
651 (set-case-syntax-pair (+ c 8) c tbl))
652 (setq c (1+ c)))
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 (set-case-syntax-pair ?ᾼ ?ᾳ tbl)
658 (set-case-syntax-pair ?Ὲ ?ὲ tbl)
659 (set-case-syntax-pair ?Έ ?έ tbl)
660 (set-case-syntax-pair ?Ὴ ?ὴ tbl)
661 (set-case-syntax-pair ?Ή ?ή tbl)
662 (set-case-syntax-pair ?ῌ ?ῃ tbl)
663 (set-case-syntax-pair ?Ῐ ?ῐ tbl)
664 (set-case-syntax-pair ?Ῑ ?ῑ tbl)
665 (set-case-syntax-pair ?Ὶ ?ὶ tbl)
666 (set-case-syntax-pair ?Ί ?ί tbl)
667 (set-case-syntax-pair ?Ῠ ?ῠ tbl)
668 (set-case-syntax-pair ?Ῡ ?ῡ tbl)
669 (set-case-syntax-pair ?Ὺ ?ὺ tbl)
670 (set-case-syntax-pair ?Ύ ?ύ tbl)
671 (set-case-syntax-pair ?Ῥ ?ῥ tbl)
672 (set-case-syntax-pair ?Ὸ ?ὸ tbl)
673 (set-case-syntax-pair ?Ό ?ό tbl)
674 (set-case-syntax-pair ?Ὼ ?ὼ tbl)
675 (set-case-syntax-pair ?Ώ ?ώ tbl)
676 (set-case-syntax-pair ?ῼ ?ῳ tbl)
677
678 ;; cyrillic
679 (modify-category-entry '(#x0400 . #x04FF) ?y)
680 (setq c #x0400)
681 (while (<= c #x04ff)
682 (and (>= c #x0400)
683 (<= c #x040f)
684 (set-case-syntax-pair c (+ c 80) tbl))
685 (and (>= c #x0410)
686 (<= c #x042f)
687 (set-case-syntax-pair c (+ c 32) tbl))
688 (and (zerop (% c 2))
689 (or (and (>= c #x0460) (<= c #x0480))
690 (and (>= c #x048c) (<= c #x04be))
691 (and (>= c #x04d0) (<= c #x04f4)))
692 (set-case-syntax-pair c (1+ c) tbl))
693 (setq c (1+ c)))
694 (set-case-syntax-pair ?Ӂ ?ӂ tbl)
695 (set-case-syntax-pair ?Ӄ ?ӄ tbl)
696 (set-case-syntax-pair ?Ӈ ?ӈ tbl)
697 (set-case-syntax-pair ?Ӌ ?ӌ tbl)
698 (set-case-syntax-pair ?Ӹ ?ӹ tbl)
699
700 ;; general punctuation
701 (setq c #x2000)
702 (while (<= c #x200b)
703 (set-case-syntax c " " tbl)
704 (setq c (1+ c)))
705 (while (<= c #x200F)
706 (set-case-syntax c "." tbl)
707 (setq c (1+ c)))
708 ;; Fixme: These aren't all right:
709 (setq c #x2010)
710 (while (<= c #x2016)
711 (set-case-syntax c "_" tbl)
712 (setq c (1+ c)))
713 ;; Punctuation syntax for quotation marks (like `)
714 (while (<= c #x201f)
715 (set-case-syntax c "." tbl)
716 (setq c (1+ c)))
717 ;; Fixme: These aren't all right:
718 (while (<= c #x2027)
719 (set-case-syntax c "_" tbl)
720 (setq c (1+ c)))
721 (while (<= c #x206F)
722 (set-case-syntax c "." tbl)
723 (setq c (1+ c)))
724
725 ;; Roman numerals
726 (setq c #x2160)
727 (while (<= c #x216f)
728 (set-case-syntax-pair c (+ c #x10) tbl)
729 (setq c (1+ c)))
730
731 ;; Fixme: The following blocks might be better as symbol rather than
732 ;; punctuation.
733 ;; Arrows
734 (setq c #x2190)
735 (while (<= c #x21FF)
736 (set-case-syntax c "." tbl)
737 (setq c (1+ c)))
738 ;; Mathematical Operators
739 (while (<= c #x22FF)
740 (set-case-syntax c "." tbl)
741 (setq c (1+ c)))
742 ;; Miscellaneous Technical
743 (while (<= c #x23FF)
744 (set-case-syntax c "." tbl)
745 (setq c (1+ c)))
746 ;; Control Pictures
747 (while (<= c #x243F)
748 (set-case-syntax c "_" tbl)
749 (setq c (1+ c)))
750
751 ;; Circled Latin
752 (setq c #x24b6)
753 (while (<= c #x24cf)
754 (set-case-syntax-pair c (+ c 26) tbl)
755 (modify-category-entry c ?l)
756 (modify-category-entry (+ c 26) ?l)
757 (setq c (1+ c)))
758
759 ;; Fullwidth Latin
760 (setq c #xff21)
761 (while (<= c #xff3a)
762 (set-case-syntax-pair c (+ c #x20) tbl)
763 (modify-category-entry c ?l)
764 (modify-category-entry (+ c #x20) ?l)
765 (setq c (1+ c)))
766
767 ;; Combining diacritics
768 (modify-category-entry '(#x300 . #x362) ?^)
769 ;; Combining marks
770 (modify-category-entry '(#x20d0 . #x20e3) ?^)
771
772 ;; Fixme: syntax for symbols &c
773 )
774
775 (let ((pairs
776 '("⁅⁆" ; U+2045 U+2046
777 "⁽⁾" ; U+207D U+207E
778 "₍₎" ; U+208D U+208E
779 "〈〉" ; U+2329 U+232A
780 "⎴⎵" ; U+23B4 U+23B5
781 "❨❩" ; U+2768 U+2769
782 "❪❫" ; U+276A U+276B
783 "❬❭" ; U+276C U+276D
784 "❰❱" ; U+2770 U+2771
785 "❲❳" ; U+2772 U+2773
786 "❴❵" ; U+2774 U+2775
787 "⟦⟧" ; U+27E6 U+27E7
788 "⟨⟩" ; U+27E8 U+27E9
789 "⟪⟫" ; U+27EA U+27EB
790 "⦃⦄" ; U+2983 U+2984
791 "⦅⦆" ; U+2985 U+2986
792 "⦇⦈" ; U+2987 U+2988
793 "⦉⦊" ; U+2989 U+298A
794 "⦋⦌" ; U+298B U+298C
795 "⦍⦎" ; U+298D U+298E
796 "⦏⦐" ; U+298F U+2990
797 "⦑⦒" ; U+2991 U+2992
798 "⦓⦔" ; U+2993 U+2994
799 "⦕⦖" ; U+2995 U+2996
800 "⦗⦘" ; U+2997 U+2998
801 "⧼⧽" ; U+29FC U+29FD
802 "〈〉" ; U+3008 U+3009
803 "《》" ; U+300A U+300B
804 "「」" ; U+300C U+300D
805 "『』" ; U+300E U+300F
806 "【】" ; U+3010 U+3011
807 "〔〕" ; U+3014 U+3015
808 "〖〗" ; U+3016 U+3017
809 "〘〙" ; U+3018 U+3019
810 "〚〛" ; U+301A U+301B
811 "﴾﴿" ; U+FD3E U+FD3F
812 "︵︶" ; U+FE35 U+FE36
813 "︷︸" ; U+FE37 U+FE38
814 "︹︺" ; U+FE39 U+FE3A
815 "︻︼" ; U+FE3B U+FE3C
816 "︽︾" ; U+FE3D U+FE3E
817 "︿﹀" ; U+FE3F U+FE40
818 "﹁﹂" ; U+FE41 U+FE42
819 "﹃﹄" ; U+FE43 U+FE44
820 "﹙﹚" ; U+FE59 U+FE5A
821 "﹛﹜" ; U+FE5B U+FE5C
822 "﹝﹞" ; U+FE5D U+FE5E
823 "()" ; U+FF08 U+FF09
824 "[]" ; U+FF3B U+FF3D
825 "{}" ; U+FF5B U+FF5D
826 "⦅⦆" ; U+FF5F U+FF60
827 "「」" ; U+FF62 U+FF63
828 )))
829 (dolist (elt pairs)
830 (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
831 (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
832
833 \f
834 ;; For each character set, put the information of the most proper
835 ;; coding system to encode it by `preferred-coding-system' property.
836
837 ;; Fixme: should this be junked?
838 (let ((l '((latin-iso8859-1 . iso-latin-1)
839 (latin-iso8859-2 . iso-latin-2)
840 (latin-iso8859-3 . iso-latin-3)
841 (latin-iso8859-4 . iso-latin-4)
842 (thai-tis620 . thai-tis620)
843 (greek-iso8859-7 . greek-iso-8bit)
844 (arabic-iso8859-6 . iso-2022-7bit)
845 (hebrew-iso8859-8 . hebrew-iso-8bit)
846 (katakana-jisx0201 . japanese-shift-jis)
847 (latin-jisx0201 . japanese-shift-jis)
848 (cyrillic-iso8859-5 . cyrillic-iso-8bit)
849 (latin-iso8859-9 . iso-latin-5)
850 (japanese-jisx0208-1978 . iso-2022-jp)
851 (chinese-gb2312 . chinese-iso-8bit)
852 (chinese-gbk . chinese-gbk)
853 (gb18030-2-byte . chinese-gb18030)
854 (gb18030-4-byte-bmp . chinese-gb18030)
855 (gb18030-4-byte-smp . chinese-gb18030)
856 (gb18030-4-byte-ext-1 . chinese-gb18030)
857 (gb18030-4-byte-ext-2 . chinese-gb18030)
858 (japanese-jisx0208 . iso-2022-jp)
859 (korean-ksc5601 . iso-2022-kr)
860 (japanese-jisx0212 . iso-2022-jp)
861 (chinese-big5-1 . chinese-big5)
862 (chinese-big5-2 . chinese-big5)
863 (chinese-sisheng . iso-2022-7bit)
864 (ipa . iso-2022-7bit)
865 (vietnamese-viscii-lower . vietnamese-viscii)
866 (vietnamese-viscii-upper . vietnamese-viscii)
867 (arabic-digit . iso-2022-7bit)
868 (arabic-1-column . iso-2022-7bit)
869 (lao . lao)
870 (arabic-2-column . iso-2022-7bit)
871 (indian-is13194 . devanagari)
872 (indian-glyph . devanagari)
873 (tibetan-1-column . tibetan)
874 (ethiopic . iso-2022-7bit)
875 (chinese-cns11643-1 . iso-2022-cn)
876 (chinese-cns11643-2 . iso-2022-cn)
877 (chinese-cns11643-3 . iso-2022-cn)
878 (chinese-cns11643-4 . iso-2022-cn)
879 (chinese-cns11643-5 . iso-2022-cn)
880 (chinese-cns11643-6 . iso-2022-cn)
881 (chinese-cns11643-7 . iso-2022-cn)
882 (indian-2-column . devanagari)
883 (tibetan . tibetan)
884 (latin-iso8859-14 . iso-latin-8)
885 (latin-iso8859-15 . iso-latin-9))))
886 (while l
887 (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
888 (setq l (cdr l))))
889
890 \f
891 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
892 ;; SPACE and NEWLINE are already set.
893
894 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
895 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
896 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
897 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
898 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
899 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
900
901 \f
902 ;;; Setting char-width-table. The default is 1.
903
904 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
905 ;; and final characters.
906 (let ((l '((#x0300 . #x036F)
907 (#x0483 . #x0489)
908 (#x0591 . #x05BD)
909 (#x05BF . #x05BF)
910 (#x05C1 . #x05C2)
911 (#x05C4 . #x05C5)
912 (#x05C7 . #x05C7)
913 (#x0600 . #x0603)
914 (#x0610 . #x0615)
915 (#x064B . #x065E)
916 (#x0670 . #x0670)
917 (#x06D6 . #x06E4)
918 (#x06E7 . #x06E8)
919 (#x06EA . #x06ED)
920 (#x070F . #x070F)
921 (#x0711 . #x0711)
922 (#x0730 . #x074A)
923 (#x07A6 . #x07B0)
924 (#x07EB . #x07F3)
925 (#x0901 . #x0902)
926 (#x093C . #x093C)
927 (#x0941 . #x0948)
928 (#x094D . #x094D)
929 (#x0951 . #x0954)
930 (#x0962 . #x0963)
931 (#x0981 . #x0981)
932 (#x09BC . #x09BC)
933 (#x09C1 . #x09C4)
934 (#x09CD . #x09CD)
935 (#x09E2 . #x09E3)
936 (#x0A01 . #x0A02)
937 (#x0A3C . #x0A3C)
938 (#x0A41 . #x0A4D)
939 (#x0A70 . #x0A71)
940 (#x0A81 . #x0A82)
941 (#x0ABC . #x0ABC)
942 (#x0AC1 . #x0AC8)
943 (#x0ACD . #x0ACD)
944 (#x0AE2 . #x0AE3)
945 (#x0B01 . #x0B01)
946 (#x0B3C . #x0B3C)
947 (#x0B3F . #x0B3F)
948 (#x0B41 . #x0B43)
949 (#x0B4D . #x0B56)
950 (#x0B82 . #x0B82)
951 (#x0BC0 . #x0BC0)
952 (#x0BCD . #x0BCD)
953 (#x0C3E . #x0C40)
954 (#x0C46 . #x0C56)
955 (#x0CBC . #x0CBC)
956 (#x0CBF . #x0CBF)
957 (#x0CC6 . #x0CC6)
958 (#x0CCC . #x0CCD)
959 (#x0CE2 . #x0CE3)
960 (#x0D41 . #x0D43)
961 (#x0D4D . #x0D4D)
962 (#x0DCA . #x0DCA)
963 (#x0DD2 . #x0DD6)
964 (#x0E31 . #x0E31)
965 (#x0E34 . #x0E3A)
966 (#x0E47 . #x0E4E)
967 (#x0EB1 . #x0EB1)
968 (#x0EB4 . #x0EBC)
969 (#x0EC8 . #x0ECD)
970 (#x0F18 . #x0F19)
971 (#x0F35 . #x0F35)
972 (#x0F37 . #x0F37)
973 (#x0F39 . #x0F39)
974 (#x0F71 . #x0F7E)
975 (#x0F80 . #x0F84)
976 (#x0F86 . #x0F87)
977 (#x0F90 . #x0FBC)
978 (#x0FC6 . #x0FC6)
979 (#x102D . #x1030)
980 (#x1032 . #x1037)
981 (#x1039 . #x1039)
982 (#x1058 . #x1059)
983 (#x1160 . #x11FF)
984 (#x135F . #x135F)
985 (#x1712 . #x1714)
986 (#x1732 . #x1734)
987 (#x1752 . #x1753)
988 (#x1772 . #x1773)
989 (#x17B4 . #x17B5)
990 (#x17B7 . #x17BD)
991 (#x17C6 . #x17C6)
992 (#x17C9 . #x17D3)
993 (#x17DD . #x17DD)
994 (#x180B . #x180D)
995 (#x18A9 . #x18A9)
996 (#x1920 . #x1922)
997 (#x1927 . #x1928)
998 (#x1932 . #x1932)
999 (#x1939 . #x193B)
1000 (#x1A17 . #x1A18)
1001 (#x1B00 . #x1B03)
1002 (#x1B34 . #x1B34)
1003 (#x1B36 . #x1B3A)
1004 (#x1B3C . #x1B3C)
1005 (#x1B42 . #x1B42)
1006 (#x1B6B . #x1B73)
1007 (#x1DC0 . #x1DFF)
1008 (#x200B . #x200F)
1009 (#x202A . #x202E)
1010 (#x2060 . #x206F)
1011 (#x20D0 . #x20EF)
1012 (#x302A . #x302F)
1013 (#x3099 . #x309A)
1014 (#xA806 . #xA806)
1015 (#xA80B . #xA80B)
1016 (#xA825 . #xA826)
1017 (#xFB1E . #xFB1E)
1018 (#xFE00 . #xFE0F)
1019 (#xFE20 . #xFE23)
1020 (#xFEFF . #xFEFF)
1021 (#xFFF9 . #xFFFB)
1022 (#x10A01 . #x10A0F)
1023 (#x10A38 . #x10A3F)
1024 (#x1D167 . #x1D169)
1025 (#x1D173 . #x1D182)
1026 (#x1D185 . #x1D18B)
1027 (#x1D1AA . #x1D1AD)
1028 (#x1D242 . #x1D244)
1029 (#xE0001 . #xE01EF))))
1030 (dolist (elt l)
1031 (set-char-table-range char-width-table elt 0)))
1032
1033 ;; 2: East Asian Wide and Full-width characters.
1034 (let ((l '((#x1100 . #x115F)
1035 (#x2329 . #x232A)
1036 (#x2E80 . #x303E)
1037 (#x3040 . #xA4CF)
1038 (#xAC00 . #xD7A3)
1039 (#xF900 . #xFAFF)
1040 (#xFE30 . #xFE6F)
1041 (#xFF01 . #xFF60)
1042 (#xFFE0 . #xFFE6)
1043 (#x20000 . #x2FFFF)
1044 (#x30000 . #x3FFFF))))
1045 (dolist (elt l)
1046 (set-char-table-range char-width-table elt 2)))
1047
1048 ;; Other double width
1049 ;;(map-charset-chars
1050 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1051 ;; 'ethiopic)
1052 ;; (map-charset-chars
1053 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1054 ;; 'tibetan)
1055 (map-charset-chars
1056 (lambda (range ignore) (set-char-table-range char-width-table range 2))
1057 'indian-2-column)
1058 (map-charset-chars
1059 (lambda (range ignore) (set-char-table-range char-width-table range 2))
1060 'arabic-2-column)
1061
1062 ;; Internal use only.
1063 ;; Alist of locale symbol vs charsets. In a language environment
1064 ;; corresponding to the locale, width of characters in the charsets is
1065 ;; set to 2. Each element has the form:
1066 ;; (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1067 ;; LOCALE: locale symbol
1068 ;; TABLE: char-table used for char-width-table, initially nil.
1069 ;; CAHRSET: character set
1070 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1071
1072 (defvar cjk-char-width-table-list
1073 '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1074 (cp932-2-byte (#x8140 . #x879F)))
1075 (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1076 (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1077 (zh_TW nil (big5 (#xA140 . #xA3FE))
1078 (chinese-cns11643-1 (#x2121 . #x427E)))
1079 (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1080
1081 ;; Internal use only.
1082 ;; Setup char-width-table appropriate for a language environment
1083 ;; corresponding to LOCALE-NAME (symbol).
1084
1085 (defun use-cjk-char-width-table (locale-name)
1086 (while (char-table-parent char-width-table)
1087 (setq char-width-table (char-table-parent char-width-table)))
1088 (let ((slot (assq locale-name cjk-char-width-table-list))
1089 table)
1090 (or slot (error "Unknown locale for CJK language environment: %s"
1091 locale-name))
1092 (unless (nth 1 slot)
1093 (let ((table (make-char-table nil)))
1094 (dolist (charset-info (nthcdr 2 slot))
1095 (let ((charset (car charset-info)))
1096 (dolist (code-range (cdr charset-info))
1097 (map-charset-chars #'(lambda (range arg)
1098 (set-char-table-range table range 2))
1099 charset nil
1100 (car code-range) (cdr code-range)))))
1101 (optimize-char-table table)
1102 (set-char-table-parent table char-width-table)
1103 (setcar (cdr slot) table)))
1104 (setq char-width-table (nth 1 slot))))
1105
1106 (defun use-default-char-width-table ()
1107 "Internal use only.
1108 Setup char-width-table appropriate for non-CJK language environment."
1109 (while (char-table-parent char-width-table)
1110 (setq char-width-table (char-table-parent char-width-table))))
1111
1112 (optimize-char-table (standard-case-table))
1113 (optimize-char-table (standard-syntax-table))
1114
1115 \f
1116 ;; Setting char-script-table.
1117
1118 ;; The data is compiled from Blocks.txt and Scripts.txt in the
1119 ;; "Unicode Character Database", simplified to lump together all the
1120 ;; blocks belonging to the same language. E.g., "Basic Latin",
1121 ;; "Latin-1 Supplement", "Latin Extended-A", etc. are all lumped
1122 ;; together under "latin".
1123 ;;
1124 ;; The Unicode blocks actually extend past some of these ranges with
1125 ;; undefined codepoints.
1126 (let ((script-list nil))
1127 (dolist
1128 (elt
1129 '((#x0000 #x007F latin)
1130 (#x00A0 #x024F latin)
1131 (#x0250 #x02AF phonetic)
1132 (#x02B0 #x036F latin)
1133 (#x0370 #x03E1 greek)
1134 (#x03E2 #x03EF coptic)
1135 (#x03F0 #x03F3 greek)
1136 (#x0400 #x052F cyrillic)
1137 (#x0530 #x058F armenian)
1138 (#x0590 #x05FF hebrew)
1139 (#x0600 #x06FF arabic)
1140 (#x0700 #x074F syriac)
1141 (#x0750 #x077F arabic)
1142 (#x0780 #x07BF thaana)
1143 (#x07C0 #x07FF nko)
1144 (#x0800 #x083F samaritan)
1145 (#x0840 #x085F mandaic)
1146 (#x08A0 #x08FF arabic)
1147 (#x0900 #x097F devanagari)
1148 (#x0980 #x09FF bengali)
1149 (#x0A00 #x0A7F gurmukhi)
1150 (#x0A80 #x0AFF gujarati)
1151 (#x0B00 #x0B7F oriya)
1152 (#x0B80 #x0BFF tamil)
1153 (#x0C00 #x0C7F telugu)
1154 (#x0C80 #x0CFF kannada)
1155 (#x0D00 #x0D7F malayalam)
1156 (#x0D80 #x0DFF sinhala)
1157 (#x0E00 #x0E7F thai)
1158 (#x0E80 #x0EFF lao)
1159 (#x0F00 #x0FFF tibetan)
1160 (#x1000 #x109F burmese) ; according to Unicode 6.1, should be "myanmar"
1161 (#x10A0 #x10FF georgian)
1162 (#x1100 #x11FF hangul)
1163 (#x1200 #x139F ethiopic)
1164 (#x13A0 #x13FF cherokee)
1165 (#x1400 #x167F canadian-aboriginal)
1166 (#x1680 #x169F ogham)
1167 (#x16A0 #x16FF runic)
1168 (#x1700 #x171F tagalog)
1169 (#x1720 #x173F hanunoo)
1170 (#x1740 #x175F buhid)
1171 (#x1760 #x177F tagbanwa)
1172 (#x1780 #x17FF khmer)
1173 (#x1800 #x18AF mongolian)
1174 (#x18B0 #x18FF canadian-aboriginal)
1175 (#x1900 #x194F limbu)
1176 (#x1950 #x197F tai-le)
1177 (#x1980 #x19DF tai-lue)
1178 (#x19E0 #x19FF khmer)
1179 (#x1A00 #x1A00 buginese)
1180 (#x1A20 #x1AAF tai-tham)
1181 (#x1B00 #x1B7F balinese)
1182 (#x1B80 #x1BBF sundanese)
1183 (#x1BC0 #x1BFF batak)
1184 (#x1C00 #x1C4F lepcha)
1185 (#x1C50 #x1C7F ol-chiki)
1186 (#x1CC0 #x1CCF sundanese)
1187 (#x1CD0 #x1CFF vedic)
1188 (#x1D00 #x1DBF phonetic)
1189 (#x1DC0 #x1EFF latin)
1190 (#x1F00 #x1FFF greek)
1191 (#x2000 #x27FF symbol)
1192 (#x2800 #x28FF braille)
1193 (#x2900 #x2BFF symbol)
1194 (#x2C00 #x2C5F glagolitic)
1195 (#x2C60 #x2C7F latin)
1196 (#x2C80 #x2CFF coptic)
1197 (#x2D00 #x2D2F georgian)
1198 (#x2D30 #x2D7F tifinagh)
1199 (#x2D80 #x2DDF ethiopic)
1200 (#x2DE0 #x2DFF cyrillic)
1201 (#x2E00 #x2E7F symbol)
1202 (#x2E80 #x2FDF han)
1203 (#x2FF0 #x2FFF ideographic-description)
1204 (#x3000 #x303F cjk-misc)
1205 (#x3040 #x30FF kana)
1206 (#x3100 #x312F bopomofo)
1207 (#x3130 #x318F hangul)
1208 (#x3190 #x319F kanbun)
1209 (#x31A0 #x31BF bopomofo)
1210 (#x31C0 #x31EF cjk-misc)
1211 (#x31F0 #x31FF kana)
1212 (#x3200 #x9FAF han)
1213 (#xA000 #xA4CF yi)
1214 (#xA4D0 #xA4FF lisu)
1215 (#xA500 #xA63F vai)
1216 (#xA640 #xA69F cyrillic)
1217 (#xA6A0 #xA6FF bamum)
1218 (#xA700 #xA7FF latin)
1219 (#xA800 #xA82F syloti-nagri)
1220 (#xA830 #xA83F north-indic-number)
1221 (#xA840 #xA87F phags-pa)
1222 (#xA880 #xA8DF saurashtra)
1223 (#xA8E0 #xA8FF devanagari)
1224 (#xA900 #xA92F kayah-li)
1225 (#xA930 #xA95F rejang)
1226 (#xA960 #xA97F hangul)
1227 (#xA980 #xA9DF javanese)
1228 (#xAA00 #xAA5F cham)
1229 (#xAA60 #xAA7B burmese) ; Unicode 6.1: "myanmar"
1230 (#xAA80 #xAADF tai-viet)
1231 (#xAAE0 #xAAFF meetei-mayek)
1232 (#xAB00 #xAB2F ethiopic)
1233 (#xABC0 #xABFF meetei-mayek)
1234 (#xAC00 #xD7FF hangul)
1235 (#xF900 #xFAFF han)
1236 (#xFB1D #xFB4F hebrew)
1237 (#xFB50 #xFDFF arabic)
1238 (#xFE30 #xFE4F han)
1239 (#xFE70 #xFEFF arabic)
1240 (#xFF00 #xFF5F cjk-misc)
1241 (#xFF61 #xFF9F kana)
1242 (#xFFE0 #xFFE6 cjk-misc)
1243 (#x10000 #x100FF linear-b)
1244 (#x10100 #x1013F aegean-number)
1245 (#x10140 #x1018F ancient-greek-number)
1246 (#x10190 #x101CF ancient-symbol)
1247 (#x101D0 #x101FF phaistos-disc)
1248 (#x10280 #x1029F lycian)
1249 (#x102A0 #x102DF carian)
1250 (#x10300 #x1032F olt-italic)
1251 (#x10330 #x1034F gothic)
1252 (#x10380 #x1039F ugaritic)
1253 (#x103A0 #x103DF old-persian)
1254 (#x10400 #x1044F deseret)
1255 (#x10450 #x1047F shavian)
1256 (#x10480 #x104AF osmanya)
1257 (#x10800 #x1083F cypriot-syllabary)
1258 (#x10840 #x1085F aramaic)
1259 (#x10900 #x1091F phoenician)
1260 (#x10920 #x1093F lydian)
1261 (#x10980 #x109FF meroitic)
1262 (#x10A00 #x10A5F kharoshthi)
1263 (#x10A60 #x10A7F old-south-arabian)
1264 (#x10B00 #x10B3F avestan)
1265 (#x10B40 #x10B5F inscriptional-parthian)
1266 (#x10B60 #x10B7F inscriptional-pahlavi)
1267 (#x10C00 #x10C4F old-turkic)
1268 (#x10E60 #x10E7F rumi-number)
1269 (#x11000 #x1107F brahmi)
1270 (#x11080 #x110CF kaithi)
1271 (#x110D0 #x110FF sora-sompeng)
1272 (#x11100 #x1114F chakma)
1273 (#x11180 #x111DF sharada)
1274 (#x11680 #x116CF takri)
1275 (#x12000 #x123FF cuneiform)
1276 (#x12400 #x1247F cuneiform-numbers-and-punctuation)
1277 (#x13000 #x1342F egyptian)
1278 (#x16800 #x16A3F bamum)
1279 (#x16F00 #x16F9F miao)
1280 (#x1B000 #x1B0FF kana)
1281 (#x1D000 #x1D0FF byzantine-musical-symbol)
1282 (#x1D100 #x1D1FF musical-symbol)
1283 (#x1D200 #x1D24F ancient-greek-musical-notation)
1284 (#x1D300 #x1D35F tai-xuan-jing-symbol)
1285 (#x1D360 #x1D37F counting-rod-numeral)
1286 (#x1D400 #x1D7FF mathematical)
1287 (#x1EE00 #x1EEFF arabic)
1288 (#x1F000 #x1F02F mahjong-tile)
1289 (#x1F030 #x1F09F domino-tile)
1290 (#x1F0A0 #x1F0FF playing-cards)
1291 (#x1F100 #x1F1FF symbol)
1292 (#x1F200 #x1F2FF han)
1293 (#x1F300 #x1F64F symbol)
1294 (#x1F680 #x1F77F symbol)
1295 (#x20000 #x2B81F han)
1296 (#x2F800 #x2FFFF han)))
1297 (set-char-table-range char-script-table
1298 (cons (car elt) (nth 1 elt)) (nth 2 elt))
1299 (or (memq (nth 2 elt) script-list)
1300 (setq script-list (cons (nth 2 elt) script-list))))
1301 (set-char-table-extra-slot char-script-table 0 (nreverse script-list)))
1302
1303 (map-charset-chars
1304 #'(lambda (range ignore)
1305 (set-char-table-range char-script-table range 'tibetan))
1306 'tibetan)
1307
1308 \f
1309 ;;; Setting unicode-category-table.
1310
1311 (setq unicode-category-table
1312 (unicode-property-table-internal 'general-category))
1313 (map-char-table #'(lambda (key val)
1314 (if (and val
1315 (or (and (/= (aref (symbol-name val) 0) ?M)
1316 (/= (aref (symbol-name val) 0) ?C))
1317 (eq val 'Zs)))
1318 (modify-category-entry key ?.)))
1319 unicode-category-table)
1320
1321 (optimize-char-table (standard-category-table))
1322
1323 \f
1324 ;; Display of glyphless characters.
1325
1326 (defvar char-acronym-table
1327 (make-char-table 'char-acronym-table nil)
1328 "Char table of acronyms for non-graphic characters.")
1329
1330 (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
1331 "BS" nil nil "VT" "FF" "CR" "SO" "SI"
1332 "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
1333 "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US")))
1334 (dotimes (i 32)
1335 (aset char-acronym-table i (car c0-acronyms))
1336 (setq c0-acronyms (cdr c0-acronyms))))
1337
1338 (let ((c1-acronyms '("XXX" "XXX" "BPH" "NBH" "IND" "NEL" "SSA" "ESA"
1339 "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1"
1340 "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA"
1341 "SOS" "XXX" "SC1" "CSI" "ST" "OSC" "PM" "APC")))
1342 (dotimes (i 32)
1343 (aset char-acronym-table (+ #x0080 i) (car c1-acronyms))
1344 (setq c1-acronyms (cdr c1-acronyms))))
1345
1346 (aset char-acronym-table #x17B4 "KIVAQ") ; KHMER VOWEL INHERENT AQ
1347 (aset char-acronym-table #x17B5 "KIVAA") ; KHMER VOWEL INHERENT AA
1348 (aset char-acronym-table #x200B "ZWSP") ; ZERO WIDTH SPACE
1349 (aset char-acronym-table #x200C "ZWNJ") ; ZERO WIDTH NON-JOINER
1350 (aset char-acronym-table #x200D "ZWJ") ; ZERO WIDTH JOINER
1351 (aset char-acronym-table #x200E "LRM") ; LEFT-TO-RIGHT MARK
1352 (aset char-acronym-table #x200F "RLM") ; RIGHT-TO-LEFT MARK
1353 (aset char-acronym-table #x202A "LRE") ; LEFT-TO-RIGHT EMBEDDING
1354 (aset char-acronym-table #x202B "RLE") ; RIGHT-TO-LEFT EMBEDDING
1355 (aset char-acronym-table #x202C "PDF") ; POP DIRECTIONAL FORMATTING
1356 (aset char-acronym-table #x202D "LRO") ; LEFT-TO-RIGHT OVERRIDE
1357 (aset char-acronym-table #x202E "RLO") ; RIGHT-TO-LEFT OVERRIDE
1358 (aset char-acronym-table #x2060 "WJ") ; WORD JOINER
1359 (aset char-acronym-table #x206A "ISS") ; INHIBIT SYMMETRIC SWAPPING
1360 (aset char-acronym-table #x206B "ASS") ; ACTIVATE SYMMETRIC SWAPPING
1361 (aset char-acronym-table #x206C "IAFS") ; INHIBIT ARABIC FORM SHAPING
1362 (aset char-acronym-table #x206D "AAFS") ; ACTIVATE ARABIC FORM SHAPING
1363 (aset char-acronym-table #x206E "NADS") ; NATIONAL DIGIT SHAPES
1364 (aset char-acronym-table #x206F "NODS") ; NOMINAL DIGIT SHAPES
1365 (aset char-acronym-table #xFEFF "ZWNBSP") ; ZERO WIDTH NO-BREAK SPACE
1366 (aset char-acronym-table #xFFF9 "IAA") ; INTERLINEAR ANNOTATION ANCHOR
1367 (aset char-acronym-table #xFFFA "IAS") ; INTERLINEAR ANNOTATION SEPARATOR
1368 (aset char-acronym-table #xFFFB "IAT") ; INTERLINEAR ANNOTATION TERMINATOR
1369 (aset char-acronym-table #x1D173 "BEGBM") ; MUSICAL SYMBOL BEGIN BEAM
1370 (aset char-acronym-table #x1D174 "ENDBM") ; MUSICAL SYMBOL END BEAM
1371 (aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE
1372 (aset char-acronym-table #x1D176 "END") ; MUSICAL SYMBOL END TIE
1373 (aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR
1374 (aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR
1375 (aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE
1376 (aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE
1377 (aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG
1378 (aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE
1379 (dotimes (i 94)
1380 (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
1381 (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
1382
1383 (defun update-glyphless-char-display (&optional variable value)
1384 "Make the setting of `glyphless-char-display-control' take effect.
1385 This function updates the char-table `glyphless-char-display'."
1386 (when value
1387 (set-default variable value))
1388 (dolist (elt value)
1389 (let ((target (car elt))
1390 (method (cdr elt)))
1391 (or (memq method '(zero-width thin-space empty-box acronym hex-code))
1392 (error "Invalid glyphless character display method: %s" method))
1393 (cond ((eq target 'c0-control)
1394 (set-char-table-range glyphless-char-display '(#x00 . #x1F)
1395 method)
1396 ;; Users will not expect their newlines and TABs be
1397 ;; displayed as anything but themselves, so exempt those
1398 ;; two characters from c0-control.
1399 (set-char-table-range glyphless-char-display #x9 nil)
1400 (set-char-table-range glyphless-char-display #xa nil))
1401 ((eq target 'c1-control)
1402 (set-char-table-range glyphless-char-display '(#x80 . #x9F)
1403 method))
1404 ((eq target 'format-control)
1405 (map-char-table
1406 #'(lambda (char category)
1407 (if (eq category 'Cf)
1408 (let ((this-method method)
1409 from to)
1410 (if (consp char)
1411 (setq from (car char) to (cdr char))
1412 (setq from char to char))
1413 (while (<= from to)
1414 (when (/= from #xAD)
1415 (if (eq method 'acronym)
1416 (setq this-method
1417 (aref char-acronym-table from)))
1418 (set-char-table-range glyphless-char-display
1419 from this-method))
1420 (setq from (1+ from))))))
1421 unicode-category-table))
1422 ((eq target 'no-font)
1423 (set-char-table-extra-slot glyphless-char-display 0 method))
1424 (t
1425 (error "Invalid glyphless character group: %s" target))))))
1426
1427 ;;; Control of displaying glyphless characters.
1428 (defcustom glyphless-char-display-control
1429 '((format-control . thin-space)
1430 (no-font . hex-code))
1431 "List of directives to control display of glyphless characters.
1432
1433 Each element has the form (GROUP . METHOD), where GROUP is a
1434 symbol specifying the character group, and METHOD is a symbol
1435 specifying the method of displaying characters belonging to that
1436 group.
1437
1438 GROUP must be one of these symbols:
1439 `c0-control': U+0000..U+001F, but excluding newline and TAB.
1440 `c1-control': U+0080..U+009F.
1441 `format-control': Characters of Unicode General Category `Cf',
1442 such as U+200C (ZWNJ), U+200E (LRM), but
1443 excluding characters that have graphic images,
1444 such as U+00AD (SHY).
1445 `no-font': characters for which no suitable font is found.
1446 For character terminals, characters that cannot
1447 be encoded by `terminal-coding-system'.
1448
1449 METHOD must be one of these symbols:
1450 `zero-width': don't display.
1451 `thin-space': display a thin (1-pixel width) space. On character
1452 terminals, display as 1-character space.
1453 `empty-box': display an empty box.
1454 `acronym': display an acronym of the character in a box. The
1455 acronym is taken from `char-acronym-table', which see.
1456 `hex-code': display the hexadecimal character code in a box."
1457 :version "24.1"
1458 :type '(alist :key-type (symbol :tag "Character Group")
1459 :value-type (symbol :tag "Display Method"))
1460 :options '((c0-control
1461 (choice (const :tag "Don't display" zero-width)
1462 (const :tag "Display as thin space" thin-space)
1463 (const :tag "Display as empty box" empty-box)
1464 (const :tag "Display acronym" acronym)
1465 (const :tag "Display hex code in a box" hex-code)))
1466 (c1-control
1467 (choice (const :tag "Don't display" zero-width)
1468 (const :tag "Display as thin space" thin-space)
1469 (const :tag "Display as empty box" empty-box)
1470 (const :tag "Display acronym" acronym)
1471 (const :tag "Display hex code in a box" hex-code)))
1472 (format-control
1473 (choice (const :tag "Don't display" zero-width)
1474 (const :tag "Display as thin space" thin-space)
1475 (const :tag "Display as empty box" empty-box)
1476 (const :tag "Display acronym" acronym)
1477 (const :tag "Display hex code in a box" hex-code)))
1478 (no-font
1479 (choice (const :tag "Don't display" zero-width)
1480 (const :tag "Display as thin space" thin-space)
1481 (const :tag "Display as empty box" empty-box)
1482 (const :tag "Display acronym" acronym)
1483 (const :tag "Display hex code in a box" hex-code))))
1484 :set 'update-glyphless-char-display
1485 :group 'display)
1486
1487 \f
1488 ;;; Setting word boundary.
1489
1490 (setq word-combining-categories
1491 '((nil . ?^)
1492 (?^ . nil)
1493 (?C . ?H)
1494 (?C . ?K)))
1495
1496 (setq word-separating-categories ; (2-byte character sets)
1497 '((?H . ?K) ; Hiragana - Katakana
1498 ))
1499
1500 ;; Local Variables:
1501 ;; coding: utf-8
1502 ;; End:
1503
1504 ;;; characters.el ends here