?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Avoid segfaults when some display vector is an empty string
[emacs.git] / lisp / international / characters.el
blob33cb3d85223238e218e87b5b201bc3932341095d
1 ;;; characters.el --- set syntax and category for multibyte characters
2
3 ;; Copyright (C) 1997, 2000-2017 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 . #x4DB5) ?C)
145 (modify-category-entry '(#x4E00 . #x9FD5) ?C)
146 (modify-category-entry '(#x3400 . #x9FD5) ?c)
147 (modify-category-entry '(#x3400 . #x9FD5) ?|)
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 japanese-jisx0213.2004-1
198 cp932-2-byte))
199 (map-charset-chars #'modify-category-entry l ?j))
200
201 ;; Fullwidth characters
202 (modify-category-entry '(#xff01 . #xff60) ?\|)
203
204 ;; Unicode equivalents of JISX0201-kana
205 (let ((range '(#xff61 . #xff9f)))
206 (modify-category-entry range ?k)
207 (modify-category-entry range ?j)
208 (modify-category-entry range ?\|))
209
210 ;; Katakana block
211 (modify-category-entry '(#x3099 . #x309C) ?K)
212 (modify-category-entry '(#x30A0 . #x30FF) ?K)
213 (modify-category-entry '(#x31F0 . #x31FF) ?K)
214 (modify-category-entry '(#x30A0 . #x30FA) ?\|)
215 (modify-category-entry #x30FF ?\|)
216
217 ;; Hiragana block
218 (modify-category-entry '(#x3040 . #x309F) ?H)
219 (modify-category-entry '(#x3040 . #x3096) ?\|)
220 (modify-category-entry #x309F ?\|)
221 (modify-category-entry #x30A0 ?H)
222 (modify-category-entry #x30FC ?H)
223
224
225 ;; JISX0208
226 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
227 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
228 (let ((chars '(?ー ?゛ ?゜ ?ヽ ?ヾ ?ゝ ?ゞ ?〃 ?仝 ?々 ?〆 ?〇)))
229 (dolist (elt chars)
230 (modify-syntax-entry elt "w")))
231
232 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?A #x2321 #x237E)
233 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?H #x2421 #x247E)
234 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?K #x2521 #x257E)
235 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?G #x2621 #x267E)
236 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?Y #x2721 #x277E)
237 (map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?C #x3021 #x7E7E)
238 (let ((chars '(?仝 ?々 ?〆 ?〇)))
239 (while chars
240 (modify-category-entry (car chars) ?C)
241 (setq chars (cdr chars))))
242
243 ;; JISX0212
244
245 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0212 "_" #x2121 #x237E)
246
247 ;; JISX0201-Kana
248
249 (let ((chars '(?｡ ?､ ?･)))
250 (while chars
251 (modify-syntax-entry (car chars) ".")
252 (setq chars (cdr chars))))
253
254 (modify-syntax-entry ?\｢ "(｣")
255 (modify-syntax-entry ?\｣ "(｢")
256
257 ;; Korean character set (KSC5601)
258
259 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?h)
260
261 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
262 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
263 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
264 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
265 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
266 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
267 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
268 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?G #x2521 #x257E)
269 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?H #x2A21 #x2A7E)
270 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?K #x2B21 #x2B7E)
271 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?Y #x2C21 #x2C7E)
272
273 ;; These are in more than one charset.
274 (let ((parens (concat "〈〉《》「」『』【】〔〕〖〗〘〙〚〛"
275 "︵︶︷︸︹︺︻︼︽︾︿﹀﹁﹂﹃﹄"
276 "（）［］｛｝"))
277 open close)
278 (dotimes (i (/ (length parens) 2))
279 (setq open (aref parens (* i 2))
280 close (aref parens (1+ (* i 2))))
281 (modify-syntax-entry open (format "(%c" close))
282 (modify-syntax-entry close (format ")%c" open))))
283
284 ;; Arabic character set
285
286 (let ((charsets '(arabic-iso8859-6
287 arabic-digit
288 arabic-1-column
289 arabic-2-column)))
290 (while charsets
291 (map-charset-chars #'modify-category-entry (car charsets) ?b)
292 (setq charsets (cdr charsets))))
293 (modify-category-entry '(#x600 . #x6ff) ?b)
294 (modify-category-entry '(#x8a0 . #x8ff) ?b)
295 (modify-category-entry '(#xfb50 . #xfdff) ?b)
296 (modify-category-entry '(#xfe70 . #xfefe) ?b)
297
298 ;; Cyrillic character set (ISO-8859-5)
299
300 (modify-syntax-entry ?№ ".")
301
302 ;; Ethiopic character set
303
304 (modify-category-entry '(#x1200 . #x1399) ?e)
305 (modify-category-entry '(#x2d80 . #x2dde) ?e)
306 (let ((chars '(?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨)))
307 (while chars
308 (modify-syntax-entry (car chars) ".")
309 (setq chars (cdr chars))))
310 (map-charset-chars #'modify-category-entry 'ethiopic ?e)
311
312 ;; Hebrew character set (ISO-8859-8)
313
314 (modify-syntax-entry #x5be ".") ; MAQAF
315 (modify-syntax-entry #x5c0 ".") ; PASEQ
316 (modify-syntax-entry #x5c3 ".") ; SOF PASUQ
317 (modify-syntax-entry #x5f3 ".") ; GERESH
318 (modify-syntax-entry #x5f4 ".") ; GERSHAYIM
319
320 ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
321
322 (modify-category-entry '(#x901 . #x970) ?i)
323 (map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
324 (map-charset-chars #'modify-category-entry 'indian-2-column ?i)
325
326 ;; Lao character set
327
328 (modify-category-entry '(#xe80 . #xeff) ?o)
329 (map-charset-chars #'modify-category-entry 'lao ?o)
330
331 (let ((deflist '(("ກ-ຮ" "w" ?0) ; consonant
332 ("ະາຳຽເ-ໄ" "w" ?1) ; vowel base
333 ("ັິ-ືົໍ" "w" ?2) ; vowel upper
334 ("ຸູ" "w" ?3) ; vowel lower
335 ("່-໋" "w" ?4) ; tone mark
336 ("ຼຽ" "w" ?9) ; semivowel lower
337 ("໐-໙" "w" ?6) ; digit
338 ("ຯໆ" "_" ?5) ; symbol
339 ))
340 elm chars len syntax category to ch i)
341 (while deflist
342 (setq elm (car deflist))
343 (setq chars (car elm)
344 len (length chars)
345 syntax (nth 1 elm)
346 category (nth 2 elm)
347 i 0)
348 (while (< i len)
349 (if (= (aref chars i) ?-)
350 (setq i (1+ i)
351 to (aref chars i))
352 (setq ch (aref chars i)
353 to ch))
354 (while (<= ch to)
355 (unless (string-equal syntax "w")
356 (modify-syntax-entry ch syntax))
357 (modify-category-entry ch category)
358 (setq ch (1+ ch)))
359 (setq i (1+ i)))
360 (setq deflist (cdr deflist))))
361
362 ;; Thai character set (TIS620)
363
364 (modify-category-entry '(#xe00 . #xe7f) ?t)
365 (map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
366
367 (let ((deflist '(;; chars syntax category
368 ("ก-รลว-ฮ" "w" ?0) ; consonant
369 ("ฤฦะาำเ-ๅ" "w" ?1) ; vowel base
370 ("ัิ-ื็๎" "w" ?2) ; vowel upper
371 ("ุ-ฺ" "w" ?3) ; vowel lower
372 ("่-ํ" "w" ?4) ; tone mark
373 ("๐-๙" "w" ?6) ; digit
374 ("ฯๆ฿๏๚๛" "_" ?5) ; symbol
375 ))
376 elm chars len syntax category to ch i)
377 (while deflist
378 (setq elm (car deflist))
379 (setq chars (car elm)
380 len (length chars)
381 syntax (nth 1 elm)
382 category (nth 2 elm)
383 i 0)
384 (while (< i len)
385 (if (= (aref chars i) ?-)
386 (setq i (1+ i)
387 to (aref chars i))
388 (setq ch (aref chars i)
389 to ch))
390 (while (<= ch to)
391 (unless (string-equal syntax "w")
392 (modify-syntax-entry ch syntax))
393 (modify-category-entry ch category)
394 (setq ch (1+ ch)))
395 (setq i (1+ i)))
396 (setq deflist (cdr deflist))))
397
398 ;; Tibetan character set
399
400 (modify-category-entry '(#xf00 . #xfff) ?q)
401 (map-charset-chars #'modify-category-entry 'tibetan ?q)
402 (map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
403
404 (let ((deflist '(;; chars syntax category
405 ("ཀ-ཀྵཪ" "w" ?0) ; consonant
406 ("ྐ-ྐྵྺྻྼ" "w" ?0) ;
407 ("ིེཻོཽྀ" "w" ?2) ; upper vowel
408 ("ཾྂྃ྆྇ྈྉྊྋ" "w" ?2) ; upper modifier
409 ("྄ཱུ༙༵༷" "w" ?3) ; lower vowel/modifier
410 ("཰" "w" ?3) ; invisible vowel a
411 ("༠-༩༪-༳" "w" ?6) ; digit
412 ("་།-༒༔ཿ" "." ?|) ; line-break char
413 ("་།༏༐༑༔ཿ" "." ?|) ;
414 ("༈་།-༒༔ཿ༽༴" "." ?>) ; prohibition
415 ("་།༏༐༑༔ཿ" "." ?>) ;
416 ("ༀ-༊༼࿁࿂྅" "." ?<) ; prohibition
417 ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
418 ))
419 elm chars len syntax category to ch i)
420 (while deflist
421 (setq elm (car deflist))
422 (setq chars (car elm)
423 len (length chars)
424 syntax (nth 1 elm)
425 category (nth 2 elm)
426 i 0)
427 (while (< i len)
428 (if (= (aref chars i) ?-)
429 (setq i (1+ i)
430 to (aref chars i))
431 (setq ch (aref chars i)
432 to ch))
433 (while (<= ch to)
434 (unless (string-equal syntax "w")
435 (modify-syntax-entry ch syntax))
436 (modify-category-entry ch category)
437 (setq ch (1+ ch)))
438 (setq i (1+ i)))
439 (setq deflist (cdr deflist))))
440
441 ;; Vietnamese character set
442
443 ;; To make a word with Latin characters
444 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
445 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
446
447 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
448 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
449
450 (let ((tbl (standard-case-table))
451 (i 32))
452 (while (< i 128)
453 (let* ((char (decode-char 'vietnamese-viscii-upper i))
454 (charl (decode-char 'vietnamese-viscii-lower i))
455 (uc (encode-char char 'ucs))
456 (lc (encode-char charl 'ucs)))
457 (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
458 tbl)
459 (if uc (modify-category-entry uc ?v))
460 (if lc (modify-category-entry lc ?v)))
461 (setq i (1+ i))))
462
463 ;; Tai Viet
464 (let ((deflist '(;; chars syntax category
465 ((?ꪀ. ?ꪯ) "w" ?0) ; consonant
466 ("ꪱꪵꪶ" "w" ?1) ; vowel base
467 ((?ꪹ . ?ꪽ) "w" ?1) ; vowel base
468 ("ꪰꪲꪳꪷꪸꪾ" "w" ?2) ; vowel upper
469 ("ꪴ" "w" ?3) ; vowel lower
470 ("ꫀꫂ" "w" ?1) ; non-combining tone-mark
471 ("꪿꫁" "w" ?4) ; combining tone-mark
472 ((?ꫛ . ?꫟) "_" ?5) ; symbol
473 )))
474 (dolist (elm deflist)
475 (let ((chars (car elm))
476 (syntax (nth 1 elm))
477 (category (nth 2 elm)))
478 (if (consp chars)
479 (progn
480 (modify-syntax-entry chars syntax)
481 (modify-category-entry chars category))
482 (mapc #'(lambda (x)
483 (modify-syntax-entry x syntax)
484 (modify-category-entry x category))
485 chars)))))
486
487 ;; Bidi categories
488
489 ;; If bootstrapping without generated uni-*.el files, table not defined.
490 (let ((table (unicode-property-table-internal 'bidi-class)))
491 (when table
492 (map-char-table (lambda (key val)
493 (cond
494 ((memq val '(R AL RLO RLE))
495 (modify-category-entry key ?R))
496 ((memq val '(L LRE LRO))
497 (modify-category-entry key ?L))))
498 table)))
499
500 ;; Load uni-mirrored.el and uni-brackets.el if available, so that they
501 ;; get dumped into Emacs. This allows starting Emacs with
502 ;; force-load-messages in ~/.emacs, and avoid infinite recursion in
503 ;; bidi_initialize, which needs to load uni-mirrored.el and
504 ;; uni-brackets.el in order to display the "Loading" messages.
505 (unicode-property-table-internal 'mirroring)
506 (unicode-property-table-internal 'bracket-type)
507
508 ;; Latin
509
510 (modify-category-entry '(#x80 . #x024F) ?l)
511
512 (let ((tbl (standard-case-table)) c)
513
514 ;; Latin-1
515
516 ;; Fixme: Some of the non-word syntaxes here perhaps should be
517 ;; reviewed. (Note that the following all implicitly have word
518 ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
519 ;; relating Unicode categories to Emacs syntax codes.
520
521 ;; NBSP isn't semantically interchangeable with other whitespace chars,
522 ;; so it's more like punctuation.
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 ;; French wants
529 ;; (set-case-syntax-delims ?« ?» tbl)
530 ;; And German wants
531 ;; (set-case-syntax-delims ?» ?« tbl)
532 ;; So let's stay neutral and let users set these up if/when they want to.
533 (set-case-syntax ?« "." tbl)
534 (set-case-syntax ?» "." tbl)
535 (set-case-syntax ?¬ "_" tbl)
536 (set-case-syntax ?­ "_" tbl)
537 (set-case-syntax ?® "_" tbl)
538 (set-case-syntax ?° "_" tbl)
539 (set-case-syntax ?± "_" tbl)
540 (set-case-syntax ?µ "_" tbl)
541 (set-case-syntax ?· "_" tbl)
542 (set-case-syntax ?¼ "_" tbl)
543 (set-case-syntax ?½ "_" tbl)
544 (set-case-syntax ?¾ "_" tbl)
545 (set-case-syntax ?¿ "." tbl)
546 (set-case-syntax ?× "_" tbl)
547 (set-case-syntax ?ß "w" tbl)
548 (set-case-syntax ?÷ "_" tbl)
549 ;; See below for ÿ.
550
551 ;; Latin Extended-A, Latin Extended-B
552 (setq c #x0100)
553 (while (<= c #x02B8)
554 (modify-category-entry c ?l)
555 (setq c (1+ c)))
556
557 ;; Latin Extended Additional
558 (modify-category-entry '(#x1e00 . #x1ef9) ?l)
559
560 ;; Latin Extended-C
561 (setq c #x2C60)
562 (while (<= c #x2C7F)
563 (modify-category-entry c ?l)
564 (setq c (1+ c)))
565
566 ;; Latin Extended-D
567 (setq c #xA720)
568 (while (<= c #xA7FF)
569 (modify-category-entry c ?l)
570 (setq c (1+ c)))
571
572 ;; Latin Extended-E
573 (setq c #xAB30)
574 (while (<= c #xAB64)
575 (modify-category-entry c ?l)
576 (setq c (1+ c)))
577
578 ;; Greek
579 (modify-category-entry '(#x0370 . #x03ff) ?g)
580
581 ;; Armenian
582 (setq c #x531)
583
584 ;; Greek Extended
585 (modify-category-entry '(#x1f00 . #x1fff) ?g)
586
587 ;; cyrillic
588 (modify-category-entry '(#x0400 . #x04FF) ?y)
589 (modify-category-entry '(#xA640 . #xA69F) ?y)
590
591 ;; Georgian
592 (setq c #x10A0)
593
594 ;; Cyrillic Extended-C
595 (modify-category-entry '(#x1C80 . #x1C8F) ?y)
596
597 ;; general punctuation
598 (setq c #x2000)
599 (while (<= c #x200b)
600 (set-case-syntax c " " tbl)
601 (setq c (1+ c)))
602 (while (<= c #x200F)
603 (set-case-syntax c "." tbl)
604 (setq c (1+ c)))
605 ;; Fixme: These aren't all right:
606 (setq c #x2010)
607 (while (<= c #x2016)
608 (set-case-syntax c "_" tbl)
609 (setq c (1+ c)))
610 ;; Punctuation syntax for quotation marks (like `)
611 (while (<= c #x201f)
612 (set-case-syntax c "." tbl)
613 (setq c (1+ c)))
614 ;; Fixme: These aren't all right:
615 (while (<= c #x2027)
616 (set-case-syntax c "_" tbl)
617 (setq c (1+ c)))
618 (while (<= c #x206F)
619 (set-case-syntax c "." tbl)
620 (setq c (1+ c)))
621
622 ;; Fixme: The following blocks might be better as symbol rather than
623 ;; punctuation.
624 ;; Arrows
625 (setq c #x2190)
626 (while (<= c #x21FF)
627 (set-case-syntax c "." tbl)
628 (setq c (1+ c)))
629 ;; Mathematical Operators
630 (while (<= c #x22FF)
631 (set-case-syntax c "." tbl)
632 (setq c (1+ c)))
633 ;; Miscellaneous Technical
634 (while (<= c #x23FF)
635 (set-case-syntax c "." tbl)
636 (setq c (1+ c)))
637 ;; Control Pictures
638 (while (<= c #x243F)
639 (set-case-syntax c "_" tbl)
640 (setq c (1+ c)))
641
642 ;; Circled Latin
643 (setq c #x24b6)
644 (while (<= c #x24cf)
645 (modify-category-entry c ?l)
646 (modify-category-entry (+ c 26) ?l)
647 (setq c (1+ c)))
648
649 ;; Coptic
650 ;; There's no Coptic category. However, Coptic letters that are
651 ;; part of the Greek block above get the Greek category, and those
652 ;; in this block are derived from Greek letters, so let's be
653 ;; consistent about their category.
654 (modify-category-entry '(#x2C80 . #x2CFF) ?g)
655
656 ;; Fullwidth Latin
657 (setq c #xff21)
658 (while (<= c #xff3a)
659 (modify-category-entry c ?l)
660 (modify-category-entry (+ c #x20) ?l)
661 (setq c (1+ c)))
662
663 ;; Combining diacritics
664 (modify-category-entry '(#x300 . #x362) ?^)
665 ;; Combining marks
666 (modify-category-entry '(#x20d0 . #x20ff) ?^)
667
668 (let ((gc (unicode-property-table-internal 'general-category))
669 (syn-table (standard-syntax-table)))
670 ;; In early bootstrapping Unicode tables are not available so we need to
671 ;; skip this step in those cases.
672 (when gc
673 ;; Set all Letter, uppercase; Letter, lowercase and Letter,
674 ;; titlecase syntax to word.
675 (map-char-table
676 (lambda (ch cat)
677 (when (memq cat '(Lu Ll Lt))
678 (modify-syntax-entry ch "w " syn-table)))
679 gc)
680 ;; Ⅰ through Ⅻ had word syntax in the past so set it here as well.
681 ;; The general category of those characters is Number, Letter.
682 (modify-syntax-entry '(#x2160 . #x216b) "w " syn-table)
683
684 ;; ⓐ through ⓩ are symbols, other according to Unicode but Emacs set
685 ;; their syntax to word in the past so keep backwards compatibility.
686 (modify-syntax-entry '(#x24D0 . #x24E9) "w " syn-table)
687
688 ;; Set downcase and upcase from Unicode properties
689
690 ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I and
691 ;; U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so do U+0130
692 ;; LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN SMALL LETTER I.
693
694 ;; We used to set up half of those correspondence unconditionally, but
695 ;; that makes searches slow. So now we don't set up either half of these
696 ;; correspondences by default.
697
698 ;; (set-downcase-syntax ?İ ?i tbl)
699 ;; (set-upcase-syntax ?I ?ı tbl)
700
701 (let ((map-unicode-property
702 (lambda (property func)
703 (map-char-table
704 (lambda (ch cased)
705 ;; ASCII characters skipped due to reasons outlined above. As
706 ;; of Unicode 9.0, this exception affects the following:
707 ;; lc(U+0130 İ) = i
708 ;; uc(U+0131 ı) = I
709 ;; uc(U+017F ſ) = S
710 ;; uc(U+212A K) = k
711 (when (> cased 127)
712 (let ((end (if (consp ch) (cdr ch) ch)))
713 (setq ch (max 128 (if (consp ch) (car ch) ch)))
714 (while (<= ch end)
715 (funcall func ch cased)
716 (setq ch (1+ ch))))))
717 (unicode-property-table-internal property))))
718 (down tbl)
719 (up (case-table-get-table tbl 'up)))
720
721 ;; This works on an assumption that if toUpper(x) != x then toLower(x)
722 ;; == x (and the opposite for toLower/toUpper). This doesn’t hold for
723 ;; title case characters but those incorrect mappings will be
724 ;; overwritten later.
725 (funcall map-unicode-property 'uppercase
726 (lambda (lc uc) (aset down lc lc) (aset up uc uc)))
727 (funcall map-unicode-property 'lowercase
728 (lambda (uc lc) (aset down lc lc) (aset up uc uc)))
729
730 ;; Now deal with the actual mapping. This will correctly assign casing
731 ;; for title-case characters.
732 (funcall map-unicode-property 'uppercase
733 (lambda (lc uc) (aset up lc uc) (aset up uc uc)))
734 (funcall map-unicode-property 'lowercase
735 (lambda (uc lc) (aset down uc lc) (aset down lc lc))))))
736
737 ;; Clear out the extra slots so that they will be recomputed from the main
738 ;; (downcase) table and upcase table. Since we’re side-stepping the usual
739 ;; set-case-syntax-* functions, we need to do it explicitly.
740 (set-char-table-extra-slot tbl 1 nil)
741 (set-char-table-extra-slot tbl 2 nil)
742
743 ;; Fixme: syntax for symbols &c
744 )
745
746 (let ((pairs
747 '("⁅⁆" ; U+2045 U+2046
748 "⁽⁾" ; U+207D U+207E
749 "₍₎" ; U+208D U+208E
750 "〈〉" ; U+2329 U+232A
751 "⎴⎵" ; U+23B4 U+23B5
752 "❨❩" ; U+2768 U+2769
753 "❪❫" ; U+276A U+276B
754 "❬❭" ; U+276C U+276D
755 "❰❱" ; U+2770 U+2771
756 "❲❳" ; U+2772 U+2773
757 "❴❵" ; U+2774 U+2775
758 "⟦⟧" ; U+27E6 U+27E7
759 "⟨⟩" ; U+27E8 U+27E9
760 "⟪⟫" ; U+27EA U+27EB
761 "⦃⦄" ; U+2983 U+2984
762 "⦅⦆" ; U+2985 U+2986
763 "⦇⦈" ; U+2987 U+2988
764 "⦉⦊" ; U+2989 U+298A
765 "⦋⦌" ; U+298B U+298C
766 "⦍⦎" ; U+298D U+298E
767 "⦏⦐" ; U+298F U+2990
768 "⦑⦒" ; U+2991 U+2992
769 "⦓⦔" ; U+2993 U+2994
770 "⦕⦖" ; U+2995 U+2996
771 "⦗⦘" ; U+2997 U+2998
772 "⧼⧽" ; U+29FC U+29FD
773 "〈〉" ; U+3008 U+3009
774 "《》" ; U+300A U+300B
775 "「」" ; U+300C U+300D
776 "『』" ; U+300E U+300F
777 "【】" ; U+3010 U+3011
778 "〔〕" ; U+3014 U+3015
779 "〖〗" ; U+3016 U+3017
780 "〘〙" ; U+3018 U+3019
781 "〚〛" ; U+301A U+301B
782 "﴾﴿" ; U+FD3E U+FD3F
783 "︵︶" ; U+FE35 U+FE36
784 "︷︸" ; U+FE37 U+FE38
785 "︹︺" ; U+FE39 U+FE3A
786 "︻︼" ; U+FE3B U+FE3C
787 "︽︾" ; U+FE3D U+FE3E
788 "︿﹀" ; U+FE3F U+FE40
789 "﹁﹂" ; U+FE41 U+FE42
790 "﹃﹄" ; U+FE43 U+FE44
791 "﹙﹚" ; U+FE59 U+FE5A
792 "﹛﹜" ; U+FE5B U+FE5C
793 "﹝﹞" ; U+FE5D U+FE5E
794 "（）" ; U+FF08 U+FF09
795 "［］" ; U+FF3B U+FF3D
796 "｛｝" ; U+FF5B U+FF5D
797 "｟｠" ; U+FF5F U+FF60
798 "｢｣" ; U+FF62 U+FF63
799 )))
800 (dolist (elt pairs)
801 (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
802 (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
803
804 \f
805 ;; For each character set, put the information of the most proper
806 ;; coding system to encode it by `preferred-coding-system' property.
807
808 ;; Fixme: should this be junked?
809 (let ((l '((latin-iso8859-1 . iso-latin-1)
810 (latin-iso8859-2 . iso-latin-2)
811 (latin-iso8859-3 . iso-latin-3)
812 (latin-iso8859-4 . iso-latin-4)
813 (thai-tis620 . thai-tis620)
814 (greek-iso8859-7 . greek-iso-8bit)
815 (arabic-iso8859-6 . iso-2022-7bit)
816 (hebrew-iso8859-8 . hebrew-iso-8bit)
817 (katakana-jisx0201 . japanese-shift-jis)
818 (latin-jisx0201 . japanese-shift-jis)
819 (cyrillic-iso8859-5 . cyrillic-iso-8bit)
820 (latin-iso8859-9 . iso-latin-5)
821 (japanese-jisx0208-1978 . iso-2022-jp)
822 (chinese-gb2312 . chinese-iso-8bit)
823 (chinese-gbk . chinese-gbk)
824 (gb18030-2-byte . chinese-gb18030)
825 (gb18030-4-byte-bmp . chinese-gb18030)
826 (gb18030-4-byte-smp . chinese-gb18030)
827 (gb18030-4-byte-ext-1 . chinese-gb18030)
828 (gb18030-4-byte-ext-2 . chinese-gb18030)
829 (japanese-jisx0208 . iso-2022-jp)
830 (korean-ksc5601 . iso-2022-kr)
831 (japanese-jisx0212 . iso-2022-jp)
832 (chinese-big5-1 . chinese-big5)
833 (chinese-big5-2 . chinese-big5)
834 (chinese-sisheng . iso-2022-7bit)
835 (ipa . iso-2022-7bit)
836 (vietnamese-viscii-lower . vietnamese-viscii)
837 (vietnamese-viscii-upper . vietnamese-viscii)
838 (arabic-digit . iso-2022-7bit)
839 (arabic-1-column . iso-2022-7bit)
840 (lao . lao)
841 (arabic-2-column . iso-2022-7bit)
842 (indian-is13194 . devanagari)
843 (indian-glyph . devanagari)
844 (tibetan-1-column . tibetan)
845 (ethiopic . iso-2022-7bit)
846 (chinese-cns11643-1 . iso-2022-cn)
847 (chinese-cns11643-2 . iso-2022-cn)
848 (chinese-cns11643-3 . iso-2022-cn)
849 (chinese-cns11643-4 . iso-2022-cn)
850 (chinese-cns11643-5 . iso-2022-cn)
851 (chinese-cns11643-6 . iso-2022-cn)
852 (chinese-cns11643-7 . iso-2022-cn)
853 (indian-2-column . devanagari)
854 (tibetan . tibetan)
855 (latin-iso8859-14 . iso-latin-8)
856 (latin-iso8859-15 . iso-latin-9))))
857 (while l
858 (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
859 (setq l (cdr l))))
860
861 \f
862 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
863 ;; SPACE and NEWLINE are already set.
864
865 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
866 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
867 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
868 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
869 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
870 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
871
872 \f
873 ;;; Setting char-width-table. The default is 1.
874
875 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
876 ;; and final characters.
877 (let ((l '((#x0300 . #x036F)
878 (#x0483 . #x0489)
879 (#x0591 . #x05BD)
880 (#x05BF . #x05BF)
881 (#x05C1 . #x05C2)
882 (#x05C4 . #x05C5)
883 (#x05C7 . #x05C7)
884 (#x0600 . #x0605)
885 (#x0610 . #x061C)
886 (#x064B . #x065F)
887 (#x0670 . #x0670)
888 (#x06D6 . #x06E4)
889 (#x06E7 . #x06E8)
890 (#x06EA . #x06ED)
891 (#x070F . #x070F)
892 (#x0711 . #x0711)
893 (#x0730 . #x074A)
894 (#x07A6 . #x07B0)
895 (#x07EB . #x07F3)
896 (#x0816 . #x0823)
897 (#x0825 . #x082D)
898 (#x0859 . #x085B)
899 (#x08D4 . #x0902)
900 (#x093A . #x093A)
901 (#x093C . #x093C)
902 (#x0941 . #x0948)
903 (#x094D . #x094D)
904 (#x0951 . #x0957)
905 (#x0962 . #x0963)
906 (#x0981 . #x0981)
907 (#x09BC . #x09BC)
908 (#x09C1 . #x09C4)
909 (#x09CD . #x09CD)
910 (#x09E2 . #x09E3)
911 (#x0A01 . #x0A02)
912 (#x0A3C . #x0A3C)
913 (#x0A41 . #x0A4D)
914 (#x0A41 . #x0A42)
915 (#x0A47 . #x0A48)
916 (#x0A4B . #x0A4D)
917 (#x0A51 . #x0A51)
918 (#x0A70 . #x0A71)
919 (#x0A75 . #x0A75)
920 (#x0A81 . #x0A82)
921 (#x0ABC . #x0ABC)
922 (#x0AC1 . #x0AC8)
923 (#x0ACD . #x0ACD)
924 (#x0AE2 . #x0AE3)
925 (#x0B01 . #x0B01)
926 (#x0B3C . #x0B3C)
927 (#x0B3F . #x0B3F)
928 (#x0B41 . #x0B44)
929 (#x0B4D . #x0B56)
930 (#x0B62 . #x0B63)
931 (#x0B82 . #x0B82)
932 (#x0BC0 . #x0BC0)
933 (#x0BCD . #x0BCD)
934 (#x0C00 . #x0C00)
935 (#x0C3E . #x0C40)
936 (#x0C46 . #x0C56)
937 (#x0C62 . #x0C63)
938 (#x0C81 . #x0C81)
939 (#x0CBC . #x0CBC)
940 (#x0CCC . #x0CCD)
941 (#x0CE2 . #x0CE3)
942 (#x0D01 . #x0D01)
943 (#x0D41 . #x0D44)
944 (#x0D4D . #x0D4D)
945 (#x0D62 . #x0D63)
946 (#x0DCA . #x0DCA)
947 (#x0DD2 . #x0DD6)
948 (#x0E31 . #x0E31)
949 (#x0E34 . #x0E3A)
950 (#x0E47 . #x0E4E)
951 (#x0EB1 . #x0EB1)
952 (#x0EB4 . #x0EBC)
953 (#x0EC8 . #x0ECD)
954 (#x0F18 . #x0F19)
955 (#x0F35 . #x0F35)
956 (#x0F37 . #x0F37)
957 (#x0F39 . #x0F39)
958 (#x0F71 . #x0F7E)
959 (#x0F80 . #x0F84)
960 (#x0F86 . #x0F87)
961 (#x0F8D . #x0FBC)
962 (#x0FC6 . #x0FC6)
963 (#x102D . #x1030)
964 (#x1032 . #x1037)
965 (#x1039 . #x103A)
966 (#x103D . #x103E)
967 (#x1058 . #x1059)
968 (#x105E . #x1160)
969 (#x1171 . #x1074)
970 (#x1082 . #x1082)
971 (#x1085 . #x1086)
972 (#x108D . #x108D)
973 (#x109D . #x109D)
974 (#x135D . #x135F)
975 (#x1712 . #x1714)
976 (#x1732 . #x1734)
977 (#x1752 . #x1753)
978 (#x1772 . #x1773)
979 (#x17B4 . #x17B5)
980 (#x17B7 . #x17BD)
981 (#x17C6 . #x17C6)
982 (#x17C9 . #x17D3)
983 (#x17DD . #x17DD)
984 (#x180B . #x180E)
985 (#x18A9 . #x18A9)
986 (#x1885 . #x1886)
987 (#x18A9 . #x18A9)
988 (#x1920 . #x1922)
989 (#x1927 . #x1928)
990 (#x1932 . #x1932)
991 (#x1939 . #x193B)
992 (#x1A17 . #x1A18)
993 (#x1A1B . #x1A1B)
994 (#x1A56 . #x1A56)
995 (#x1A58 . #x1A5E)
996 (#x1A60 . #x1A60)
997 (#x1A62 . #x1A62)
998 (#x1A65 . #x1A6C)
999 (#x1A73 . #x1A7C)
1000 (#x1A7F . #x1A7F)
1001 (#x1AB0 . #x1ABE)
1002 (#x1B00 . #x1B03)
1003 (#x1B34 . #x1B34)
1004 (#x1B36 . #x1B3A)
1005 (#x1B3C . #x1B3C)
1006 (#x1B42 . #x1B42)
1007 (#x1B6B . #x1B73)
1008 (#x1B80 . #x1B81)
1009 (#x1BA2 . #x1BA5)
1010 (#x1BA8 . #x1BA9)
1011 (#x1BAB . #x1BAD)
1012 (#x1BE6 . #x1BE6)
1013 (#x1BE8 . #x1BE9)
1014 (#x1BED . #x1BED)
1015 (#x1BEF . #x1BF1)
1016 (#x1C2C . #x1C33)
1017 (#x1C36 . #x1C37)
1018 (#x1CD0 . #x1CD2)
1019 (#x1CD4 . #x1CE0)
1020 (#x1CE2 . #x1CE8)
1021 (#x1CED . #x1CED)
1022 (#x1CF4 . #x1CF4)
1023 (#x1CF8 . #x1CF9)
1024 (#x1DC0 . #x1DFF)
1025 (#x200B . #x200F)
1026 (#x202A . #x202E)
1027 (#x2060 . #x206F)
1028 (#x20D0 . #x20F0)
1029 (#x2CEF . #x2CF1)
1030 (#x2D7F . #x2D7F)
1031 (#x2DE0 . #x2DFF)
1032 (#xA66F . #xA672)
1033 (#xA674 . #xA69F)
1034 (#xA6F0 . #xA6F1)
1035 (#xA802 . #xA802)
1036 (#xA806 . #xA806)
1037 (#xA80B . #xA80B)
1038 (#xA825 . #xA826)
1039 (#xA8C4 . #xA8C5)
1040 (#xA8E0 . #xA8F1)
1041 (#xA926 . #xA92D)
1042 (#xA947 . #xA951)
1043 (#xA980 . #xA9B3)
1044 (#xA9B6 . #xA9B9)
1045 (#xA9BC . #xA9BC)
1046 (#xA9E5 . #xA9E5)
1047 (#xAA29 . #xAA2E)
1048 (#xAA31 . #xAA32)
1049 (#xAA35 . #xAA36)
1050 (#xAA43 . #xAA43)
1051 (#xAA4C . #xAA4C)
1052 (#xAA7C . #xAA7C)
1053 (#xAAB0 . #xAAB0)
1054 (#xAAB2 . #xAAB4)
1055 (#xAAB7 . #xAAB8)
1056 (#xAABE . #xAABF)
1057 (#xAAC1 . #xAAC1)
1058 (#xAAEC . #xAAED)
1059 (#xAAF6 . #xAAF6)
1060 (#xABE5 . #xABE5)
1061 (#xABE8 . #xABE8)
1062 (#xABED . #xABED)
1063 (#xFB1E . #xFB1E)
1064 (#xFE00 . #xFE0F)
1065 (#xFE20 . #xFE2F)
1066 (#xFEFF . #xFEFF)
1067 (#xFFF9 . #xFFFB)
1068 (#x101FD . #x101FD)
1069 (#x102E0 . #x102E0)
1070 (#x10376 . #x1037A)
1071 (#x10A01 . #x10A0F)
1072 (#x10A38 . #x10A3F)
1073 (#x10AE5 . #x10AE6)
1074 (#x11001 . #x11001)
1075 (#x11038 . #x11046)
1076 (#x1107F . #x11081)
1077 (#x110B3 . #x110B6)
1078 (#x110B9 . #x110BA)
1079 (#x110BD . #x110BD)
1080 (#x11100 . #x11102)
1081 (#x11127 . #x1112B)
1082 (#x1112D . #x11134)
1083 (#x11173 . #x11173)
1084 (#x11180 . #x11181)
1085 (#x111B6 . #x111BE)
1086 (#x111CA . #x111CC)
1087 (#x1122F . #x11231)
1088 (#x11234 . #x11234)
1089 (#x11236 . #x11237)
1090 (#x1123E . #x1123E)
1091 (#x112DF . #x112DF)
1092 (#x112E3 . #x112EA)
1093 (#x11300 . #x11301)
1094 (#x1133C . #x1133C)
1095 (#x11340 . #x11340)
1096 (#x11366 . #x1136C)
1097 (#x11370 . #x11374)
1098 (#x11438 . #x1143F)
1099 (#x11442 . #x11444)
1100 (#x11446 . #x11446)
1101 (#x114B3 . #x114B8)
1102 (#x114BA . #x114C0)
1103 (#x114C2 . #x114C3)
1104 (#x115B2 . #x115B5)
1105 (#x115BC . #x115BD)
1106 (#x115BF . #x115C0)
1107 (#x115DC . #x115DD)
1108 (#x11633 . #x1163A)
1109 (#x1163D . #x1163D)
1110 (#x1163F . #x11640)
1111 (#x116AB . #x116AB)
1112 (#x116AD . #x116AD)
1113 (#x116B0 . #x116B5)
1114 (#x116B7 . #x116B7)
1115 (#x1171D . #x1171F)
1116 (#x11722 . #x11725)
1117 (#x11727 . #x1172B)
1118 (#x11C30 . #x11C36)
1119 (#x11C38 . #x11C3D)
1120 (#x11C92 . #x11CA7)
1121 (#x11CAA . #x11CB0)
1122 (#x11CB2 . #x11CB3)
1123 (#x11CB5 . #x11CB6)
1124 (#x16AF0 . #x16AF4)
1125 (#x16B30 . #x16B36)
1126 (#x16F8F . #x16F92)
1127 (#x1BC9D . #x1BC9E)
1128 (#x1BCA0 . #x1BCA3)
1129 (#x1D167 . #x1D169)
1130 (#x1D173 . #x1D182)
1131 (#x1D185 . #x1D18B)
1132 (#x1D1AA . #x1D1AD)
1133 (#x1D242 . #x1D244)
1134 (#x1DA00 . #x1DA36)
1135 (#x1DA3B . #x1DA6C)
1136 (#x1DA75 . #x1DA75)
1137 (#x1DA84 . #x1DA84)
1138 (#x1DA9B . #x1DA9F)
1139 (#x1DAA1 . #x1DAAF)
1140 (#x1E000 . #x1E006)
1141 (#x1E008 . #x1E018)
1142 (#x1E01B . #x1E021)
1143 (#x1E023 . #x1E024)
1144 (#x1E026 . #x1E02A)
1145 (#x1E8D0 . #x1E8D6)
1146 (#x1E944 . #x1E94A)
1147 (#xE0001 . #xE01EF))))
1148 (dolist (elt l)
1149 (set-char-table-range char-width-table elt 0)))
1150
1151 ;; 2: East Asian Wide and Full-width characters.
1152 (let ((l '((#x1100 . #x115F)
1153 (#x231A . #x231B)
1154 (#x2329 . #x232A)
1155 (#x23E9 . #x23EC)
1156 (#x23F0 . #x23F0)
1157 (#x23F3 . #x23F3)
1158 (#x25FD . #x25FE)
1159 (#x2614 . #x2615)
1160 (#x2648 . #x2653)
1161 (#x267F . #x267F)
1162 (#x2693 . #x2693)
1163 (#x26A1 . #x26A1)
1164 (#x26AA . #x26AB)
1165 (#x26BD . #x26BE)
1166 (#x26C4 . #x26C5)
1167 (#x26CE . #x26CE)
1168 (#x26D4 . #x26D4)
1169 (#x26EA . #x26EA)
1170 (#x26F2 . #x26F3)
1171 (#x26F5 . #x26F5)
1172 (#x26FA . #x26FA)
1173 (#x26FD . #x26FD)
1174 (#x2705 . #x2705)
1175 (#x270A . #x270B)
1176 (#x2728 . #x2728)
1177 (#x274C . #x274C)
1178 (#x274E . #x274E)
1179 (#x2753 . #x2755)
1180 (#x2757 . #x2757)
1181 (#x2795 . #x2797)
1182 (#x27B0 . #x27B0)
1183 (#x27BF . #x27BF)
1184 (#x2B1B . #x2B1C)
1185 (#x2B50 . #x2B50)
1186 (#x2B55 . #x2B55)
1187 (#x2E80 . #x303E)
1188 (#x3040 . #x3247)
1189 (#x3250 . #x4DBF)
1190 (#x4E00 . #xA4CF)
1191 (#xA490 . #xA4C6)
1192 (#xA960 . #xA97F)
1193 (#xAC00 . #xD7A3)
1194 (#xF900 . #xFAFF)
1195 (#xFE10 . #xFE19)
1196 (#xFE30 . #xFE6F)
1197 (#xFF01 . #xFF60)
1198 (#xFFE0 . #xFFE6)
1199 (#x16FE0 . #x16FE0)
1200 (#x17000 . #x187EC)
1201 (#x18800 . #x18AF2)
1202 (#x1B000 . #x1B001)
1203 (#x1F004 . #x1F004)
1204 (#x1F0CF . #x1F0CF)
1205 (#x1F18E . #x1F18E)
1206 (#x1F191 . #x1F19A)
1207 (#x1F200 . #x1F320)
1208 (#x1F32D . #x1F335)
1209 (#x1F337 . #x1F37C)
1210 (#x1F37E . #x1F393)
1211 (#x1F3A0 . #x1F3CA)
1212 (#x1F3CF . #x1F3D3)
1213 (#x1F3E0 . #x1F3F0)
1214 (#x1F3F4 . #x1F3F4)
1215 (#x1F3F8 . #x1F3FA)
1216 (#x1F3FB . #x1F3FF)
1217 (#x1F400 . #x1F43E)
1218 (#x1F440 . #x1F440)
1219 (#x1F442 . #x1F4FC)
1220 (#x1F4FF . #x1F53D)
1221 (#x1F54B . #x1F54E)
1222 (#x1F550 . #x1F567)
1223 (#x1F57A . #x1F57A)
1224 (#x1F595 . #x1F596)
1225 (#x1F5A4 . #x1F5A4)
1226 (#x1F5FB . #x1F5FF)
1227 (#x1F600 . #x1F64F)
1228 (#x1F680 . #x1F6C5)
1229 (#x1F6CC . #x1F6CC)
1230 (#x1F6D0 . #x1F6D2)
1231 (#x1F6EB . #x1F6EC)
1232 (#x1F6F4 . #x1F6F6)
1233 (#x1F910 . #x1F91E)
1234 (#x1F920 . #x1F927)
1235 (#x1F930 . #x1F930)
1236 (#x1F933 . #x1F93E)
1237 (#x1F940 . #x1F94B)
1238 (#x1F950 . #x1F95E)
1239 (#x1F980 . #x1F991)
1240 (#x1F9C0 . #x1F9C0)
1241 (#x20000 . #x2FFFF)
1242 (#x30000 . #x3FFFF))))
1243 (dolist (elt l)
1244 (set-char-table-range char-width-table elt 2)))
1245
1246 ;; Other double width
1247 ;;(map-charset-chars
1248 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1249 ;; 'ethiopic)
1250 ;; (map-charset-chars
1251 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1252 ;; 'tibetan)
1253 (map-charset-chars
1254 (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1255 'indian-2-column)
1256 (map-charset-chars
1257 (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1258 'arabic-2-column)
1259
1260 ;; Internal use only.
1261 ;; Alist of locale symbol vs charsets. In a language environment
1262 ;; corresponding to the locale, width of characters in the charsets is
1263 ;; set to 2. Each element has the form:
1264 ;; (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1265 ;; LOCALE: locale symbol
1266 ;; TABLE: char-table used for char-width-table, initially nil.
1267 ;; CHARSET: character set
1268 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1269
1270 (defvar cjk-char-width-table-list
1271 '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1272 (cp932-2-byte (#x8140 . #x879F)))
1273 (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1274 (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1275 (zh_TW nil (big5 (#xA140 . #xA3FE))
1276 (chinese-cns11643-1 (#x2121 . #x427E)))
1277 (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1278
1279 ;; Internal use only.
1280 ;; Setup char-width-table appropriate for a language environment
1281 ;; corresponding to LOCALE-NAME (symbol).
1282
1283 (defun use-cjk-char-width-table (locale-name)
1284 (while (char-table-parent char-width-table)
1285 (setq char-width-table (char-table-parent char-width-table)))
1286 (let ((slot (assq locale-name cjk-char-width-table-list)))
1287 (or slot (error "Unknown locale for CJK language environment: %s"
1288 locale-name))
1289 (unless (nth 1 slot)
1290 (let ((table (make-char-table nil)))
1291 (dolist (charset-info (nthcdr 2 slot))
1292 (let ((charset (car charset-info)))
1293 (dolist (code-range (cdr charset-info))
1294 (map-charset-chars #'(lambda (range _arg)
1295 (set-char-table-range table range 2))
1296 charset nil
1297 (car code-range) (cdr code-range)))))
1298 (optimize-char-table table)
1299 (set-char-table-parent table char-width-table)
1300 (setcar (cdr slot) table)))
1301 (setq char-width-table (nth 1 slot))))
1302
1303 (defun use-default-char-width-table ()
1304 "Internal use only.
1305 Setup char-width-table appropriate for non-CJK language environment."
1306 (while (char-table-parent char-width-table)
1307 (setq char-width-table (char-table-parent char-width-table))))
1308
1309 (optimize-char-table (standard-case-table))
1310 (optimize-char-table (standard-syntax-table))
1311
1312 \f
1313 ;; Setting char-script-table.
1314 (if purify-flag
1315 ;; While dumping, we can't use require, and international is not
1316 ;; in load-path.
1317 (load "international/charscript")
1318 (require 'charscript))
1319
1320 (map-charset-chars
1321 #'(lambda (range _ignore)
1322 (set-char-table-range char-script-table range 'tibetan))
1323 'tibetan)
1324
1325 \f
1326 ;;; Setting unicode-category-table.
1327
1328 (when (setq unicode-category-table
1329 (unicode-property-table-internal 'general-category))
1330 (map-char-table #'(lambda (key val)
1331 (if val
1332 (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
1333 (/= (aref (symbol-name val) 0) ?C))
1334 (eq val 'Zs))
1335 (modify-category-entry key ?.))
1336 ((eq val 'Mn)
1337 (modify-category-entry key ?^)))))
1338 unicode-category-table))
1339
1340 (optimize-char-table (standard-category-table))
1341
1342 \f
1343 ;; Display of glyphless characters.
1344
1345 (defvar char-acronym-table
1346 (make-char-table 'char-acronym-table nil)
1347 "Char table of acronyms for non-graphic characters.")
1348
1349 (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
1350 "BS" nil nil "VT" "FF" "CR" "SO" "SI"
1351 "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
1352 "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US")))
1353 (dotimes (i 32)
1354 (aset char-acronym-table i (car c0-acronyms))
1355 (setq c0-acronyms (cdr c0-acronyms))))
1356
1357 (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA"
1358 "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1"
1359 "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA"
1360 "SOS" "SGCI" "SC1" "CSI" "ST" "OSC" "PM" "APC")))
1361 (dotimes (i 32)
1362 (aset char-acronym-table (+ #x0080 i) (car c1-acronyms))
1363 (setq c1-acronyms (cdr c1-acronyms))))
1364
1365 (aset char-acronym-table #x17B4 "KIVAQ") ; KHMER VOWEL INHERENT AQ
1366 (aset char-acronym-table #x17B5 "KIVAA") ; KHMER VOWEL INHERENT AA
1367 (aset char-acronym-table #x200B "ZWSP") ; ZERO WIDTH SPACE
1368 (aset char-acronym-table #x200C "ZWNJ") ; ZERO WIDTH NON-JOINER
1369 (aset char-acronym-table #x200D "ZWJ") ; ZERO WIDTH JOINER
1370 (aset char-acronym-table #x200E "LRM") ; LEFT-TO-RIGHT MARK
1371 (aset char-acronym-table #x200F "RLM") ; RIGHT-TO-LEFT MARK
1372 (aset char-acronym-table #x202A "LRE") ; LEFT-TO-RIGHT EMBEDDING
1373 (aset char-acronym-table #x202B "RLE") ; RIGHT-TO-LEFT EMBEDDING
1374 (aset char-acronym-table #x202C "PDF") ; POP DIRECTIONAL FORMATTING
1375 (aset char-acronym-table #x202D "LRO") ; LEFT-TO-RIGHT OVERRIDE
1376 (aset char-acronym-table #x202E "RLO") ; RIGHT-TO-LEFT OVERRIDE
1377 (aset char-acronym-table #x2060 "WJ") ; WORD JOINER
1378 (aset char-acronym-table #x206A "ISS") ; INHIBIT SYMMETRIC SWAPPING
1379 (aset char-acronym-table #x206B "ASS") ; ACTIVATE SYMMETRIC SWAPPING
1380 (aset char-acronym-table #x206C "IAFS") ; INHIBIT ARABIC FORM SHAPING
1381 (aset char-acronym-table #x206D "AAFS") ; ACTIVATE ARABIC FORM SHAPING
1382 (aset char-acronym-table #x206E "NADS") ; NATIONAL DIGIT SHAPES
1383 (aset char-acronym-table #x206F "NODS") ; NOMINAL DIGIT SHAPES
1384 (aset char-acronym-table #xFEFF "ZWNBSP") ; ZERO WIDTH NO-BREAK SPACE
1385 (aset char-acronym-table #xFFF9 "IAA") ; INTERLINEAR ANNOTATION ANCHOR
1386 (aset char-acronym-table #xFFFA "IAS") ; INTERLINEAR ANNOTATION SEPARATOR
1387 (aset char-acronym-table #xFFFB "IAT") ; INTERLINEAR ANNOTATION TERMINATOR
1388 (aset char-acronym-table #x1D173 "BEGBM") ; MUSICAL SYMBOL BEGIN BEAM
1389 (aset char-acronym-table #x1D174 "ENDBM") ; MUSICAL SYMBOL END BEAM
1390 (aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE
1391 (aset char-acronym-table #x1D176 "END") ; MUSICAL SYMBOL END TIE
1392 (aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR
1393 (aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR
1394 (aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE
1395 (aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE
1396 (aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG
1397 (aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE
1398 (dotimes (i 94)
1399 (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
1400 (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
1401
1402 (defun update-glyphless-char-display (&optional variable value)
1403 "Make the setting of `glyphless-char-display-control' take effect.
1404 This function updates the char-table `glyphless-char-display'."
1405 (when value
1406 (set-default variable value))
1407 (dolist (elt value)
1408 (let ((target (car elt))
1409 (method (cdr elt)))
1410 (or (memq method '(zero-width thin-space empty-box acronym hex-code))
1411 (error "Invalid glyphless character display method: %s" method))
1412 (cond ((eq target 'c0-control)
1413 (glyphless-set-char-table-range glyphless-char-display
1414 #x00 #x1F method)
1415 ;; Users will not expect their newlines and TABs be
1416 ;; displayed as anything but themselves, so exempt those
1417 ;; two characters from c0-control.
1418 (set-char-table-range glyphless-char-display #x9 nil)
1419 (set-char-table-range glyphless-char-display #xa nil))
1420 ((eq target 'c1-control)
1421 (glyphless-set-char-table-range glyphless-char-display
1422 #x80 #x9F method))
1423 ((eq target 'format-control)
1424 (when unicode-category-table
1425 (map-char-table
1426 #'(lambda (char category)
1427 (if (eq category 'Cf)
1428 (let ((this-method method)
1429 from to)
1430 (if (consp char)
1431 (setq from (car char) to (cdr char))
1432 (setq from char to char))
1433 (while (<= from to)
1434 (when (/= from #xAD)
1435 (if (eq method 'acronym)
1436 (setq this-method
1437 (aref char-acronym-table from)))
1438 (set-char-table-range glyphless-char-display
1439 from this-method))
1440 (setq from (1+ from))))))
1441 unicode-category-table)))
1442 ((eq target 'no-font)
1443 (set-char-table-extra-slot glyphless-char-display 0 method))
1444 (t
1445 (error "Invalid glyphless character group: %s" target))))))
1446
1447 (defun glyphless-set-char-table-range (chartable from to method)
1448 (if (eq method 'acronym)
1449 (let ((i from))
1450 (while (<= i to)
1451 (set-char-table-range chartable i (aref char-acronym-table i))
1452 (setq i (1+ i))))
1453 (set-char-table-range chartable (cons from to) method)))
1454
1455 ;;; Control of displaying glyphless characters.
1456 (defcustom glyphless-char-display-control
1457 '((format-control . thin-space)
1458 (no-font . hex-code))
1459 "List of directives to control display of glyphless characters.
1460
1461 Each element has the form (GROUP . METHOD), where GROUP is a
1462 symbol specifying the character group, and METHOD is a symbol
1463 specifying the method of displaying characters belonging to that
1464 group.
1465
1466 GROUP must be one of these symbols:
1467 `c0-control': U+0000..U+001F, but excluding newline and TAB.
1468 `c1-control': U+0080..U+009F.
1469 `format-control': Characters of Unicode General Category `Cf',
1470 such as U+200C (ZWNJ), U+200E (LRM), but
1471 excluding characters that have graphic images,
1472 such as U+00AD (SHY).
1473 `no-font': characters for which no suitable font is found.
1474 For character terminals, characters that cannot
1475 be encoded by `terminal-coding-system'.
1476
1477 METHOD must be one of these symbols:
1478 `zero-width': don't display.
1479 `thin-space': display a thin (1-pixel width) space. On character
1480 terminals, display as 1-character space.
1481 `empty-box': display an empty box.
1482 `acronym': display an acronym of the character in a box. The
1483 acronym is taken from `char-acronym-table', which see.
1484 `hex-code': display the hexadecimal character code in a box.
1485
1486 Do not set its value directly from Lisp; the value takes effect
1487 only via a custom `:set'
1488 function (`update-glyphless-char-display'), which updates
1489 `glyphless-char-display'."
1490 :version "24.1"
1491 :type '(alist :key-type (symbol :tag "Character Group")
1492 :value-type (symbol :tag "Display Method"))
1493 :options '((c0-control
1494 (choice (const :tag "Don't display" zero-width)
1495 (const :tag "Display as thin space" thin-space)
1496 (const :tag "Display as empty box" empty-box)
1497 (const :tag "Display acronym" acronym)
1498 (const :tag "Display hex code in a box" hex-code)))
1499 (c1-control
1500 (choice (const :tag "Don't display" zero-width)
1501 (const :tag "Display as thin space" thin-space)
1502 (const :tag "Display as empty box" empty-box)
1503 (const :tag "Display acronym" acronym)
1504 (const :tag "Display hex code in a box" hex-code)))
1505 (format-control
1506 (choice (const :tag "Don't display" zero-width)
1507 (const :tag "Display as thin space" thin-space)
1508 (const :tag "Display as empty box" empty-box)
1509 (const :tag "Display acronym" acronym)
1510 (const :tag "Display hex code in a box" hex-code)))
1511 (no-font
1512 (choice (const :tag "Don't display" zero-width)
1513 (const :tag "Display as thin space" thin-space)
1514 (const :tag "Display as empty box" empty-box)
1515 (const :tag "Display acronym" acronym)
1516 (const :tag "Display hex code in a box" hex-code))))
1517 :set 'update-glyphless-char-display
1518 :group 'display)
1519
1520 \f
1521 ;;; Setting word boundary.
1522
1523 (setq word-combining-categories
1524 '((nil . ?^)
1525 (?^ . nil)
1526 (?C . ?H)
1527 (?C . ?K)))
1528
1529 (setq word-separating-categories ; (2-byte character sets)
1530 '((?H . ?K) ; Hiragana - Katakana
1531 ))
1532
1533 ;; Local Variables:
1534 ;; coding: utf-8
1535 ;; End:
1536
1537 ;;; characters.el ends here
Emacs repository mirror