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