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