code.delx.au - gnu-emacs/blob - 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                                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   (let ((c 192))
 547     (while (<= c 222)
 548       (set-case-syntax-pair c (+ c 32) tbl)
 549       (setq c (1+ c))))
 550   (set-case-syntax ?× "_" tbl)
 551   (set-case-syntax ?ß "w" tbl)
 552   (set-case-syntax ?÷ "_" tbl)
 553   ;; See below for ÿ.
 554
 555   ;; Latin Extended-A, Latin Extended-B
 556   (setq c #x0100)
 557   (while (<= c #x02B8)
 558     (modify-category-entry c ?l)
 559     (setq c (1+ c)))
 560
 561   (let ((pair-ranges '((#x0100 . #x012F)
 562                        (#x0132 . #x0137)
 563                        (#x0139 . #x0148)
 564                        (#x014a . #x0177)
 565                        (#x0179 . #x017E)
 566                        (#x0182 . #x0185)
 567                        (#x0187 . #x0188)
 568                        (#x018B . #x018C)
 569                        (#x0191 . #x0192)
 570                        (#x0198 . #x0199)
 571                        (#x01A0 . #x01A5)
 572                        (#x01A7 . #x01A8)
 573                        (#x01AC . #x01AD)
 574                        (#x01AF . #x01B0)
 575                        (#x01B3 . #x01B6)
 576                        (#x01B8 . #x01B9)
 577                        (#x01BC . #x01BD)
 578                        (#x01CD . #x01DC)
 579                        (#x01DE . #x01EF)
 580                        (#x01F4 . #x01F5)
 581                        (#x01F8 . #x021F)
 582                        (#x0222 . #x0233)
 583                        (#x023B . #x023C)
 584                        (#x0241 . #x0242)
 585                        (#x0246 . #x024F))))
 586     (dolist (elt pair-ranges)
 587       (let ((from (car elt)) (to (cdr elt)))
 588         (while (< from to)
 589           (set-case-syntax-pair from (1+ from) tbl)
 590           (setq from (+ from 2))))))
 591
 592   (set-case-syntax-pair ?Ÿ ?ÿ tbl)
 593
 594   ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
 595   ;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
 596   ;; do U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN
 597   ;; SMALL LETTER I.
 598
 599   ;; We used to set up half of those correspondence unconditionally,
 600   ;; but that makes searches slow.  So now we don't set up either half
 601   ;; of these correspondences by default.
 602
 603   ;; (set-downcase-syntax  ?İ ?i tbl)
 604   ;; (set-upcase-syntax    ?I ?ı tbl)
 605
 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 ?Ʋ ?ʋ tbl)
 625   (set-case-syntax-pair ?Ʒ ?ʒ tbl)
 626   ;; We use set-downcase-syntax below, since we want upcase of ǆ
 627   ;; return Ǆ, not ǅ, and the same for the rest.
 628   (set-case-syntax-pair ?Ǆ ?ǆ tbl)
 629   (set-downcase-syntax ?ǅ ?ǆ tbl)
 630   (set-case-syntax-pair ?Ǉ ?ǉ tbl)
 631   (set-downcase-syntax ?ǈ ?ǉ tbl)
 632   (set-case-syntax-pair ?Ǌ ?ǌ tbl)
 633   (set-downcase-syntax ?ǋ ?ǌ tbl)
 634
 635   ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
 636
 637   (set-case-syntax-pair ?Ǳ ?ǳ tbl)
 638   (set-downcase-syntax ?ǲ ?ǳ tbl)
 639   (set-case-syntax-pair ?Ƕ ?ƕ tbl)
 640   (set-case-syntax-pair ?Ƿ ?ƿ tbl)
 641   (set-case-syntax-pair ?Ⱥ ?ⱥ tbl)
 642   (set-case-syntax-pair ?Ƚ ?ƚ tbl)
 643   (set-case-syntax-pair ?Ⱦ ?ⱦ tbl)
 644   (set-case-syntax-pair ?Ƀ ?ƀ tbl)
 645   (set-case-syntax-pair ?Ʉ ?ʉ tbl)
 646   (set-case-syntax-pair ?Ʌ ?ʌ tbl)
 647
 648   ;; Latin Extended Additional
 649   (modify-category-entry '(#x1e00 . #x1ef9) ?l)
 650   (setq c #x1e00)
 651   (while (<= c #x1ef9)
 652     (and (zerop (% c 2))
 653          (or (<= c #x1e94) (>= c #x1ea0))
 654          (set-case-syntax-pair c (1+ c) tbl))
 655     (setq c (1+ c)))
 656
 657   ;; Latin Extended-C
 658   (setq c #x2C60)
 659   (while (<= c #x2C7F)
 660     (modify-category-entry c ?l)
 661     (setq c (1+ c)))
 662
 663   (let ((pair-ranges '((#x2C60 . #x2C61)
 664                        (#x2C67 . #x2C6C)
 665                        (#x2C72 . #x2C73)
 666                        (#x2C75 . #x2C76))))
 667     (dolist (elt pair-ranges)
 668       (let ((from (car elt)) (to (cdr elt)))
 669         (while (< from to)
 670           (set-case-syntax-pair from (1+ from) tbl)
 671           (setq from (+ from 2))))))
 672
 673   (set-case-syntax-pair ?Ɫ ?ɫ tbl)
 674   (set-case-syntax-pair ?Ᵽ ?ᵽ tbl)
 675   (set-case-syntax-pair ?Ɽ ?ɽ tbl)
 676   (set-case-syntax-pair ?Ɑ ?ɑ tbl)
 677   (set-case-syntax-pair ?Ɱ ?ɱ tbl)
 678   (set-case-syntax-pair ?Ɐ ?ɐ tbl)
 679   (set-case-syntax-pair ?Ɒ ?ɒ tbl)
 680   (set-case-syntax-pair ?Ȿ ?ȿ tbl)
 681   (set-case-syntax-pair ?Ɀ ?ɀ tbl)
 682
 683   ;; Latin Extended-D
 684   (setq c #xA720)
 685   (while (<= c #xA7FF)
 686     (modify-category-entry c ?l)
 687     (setq c (1+ c)))
 688
 689   (let ((pair-ranges '((#xA722 . #xA72F)
 690                        (#xA732 . #xA76F)
 691                        (#xA779 . #xA77C)
 692                        (#xA77E . #xA787)
 693                        (#xA78B . #xA78E)
 694                        (#xA790 . #xA793)
 695                        (#xA796 . #xA7A9)
 696                        (#xA7B4 . #xA7B7))))
 697     (dolist (elt pair-ranges)
 698       (let ((from (car elt)) (to (cdr elt)))
 699         (while (< from to)
 700           (set-case-syntax-pair from (1+ from) tbl)
 701           (setq from (+ from 2))))))
 702
 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   (set-case-syntax-pair ?Ɬ ?ɬ tbl)
 708   (set-case-syntax-pair ?Ɪ ?ɪ tbl)
 709   (set-case-syntax-pair ?Ʞ ?ʞ tbl)
 710   (set-case-syntax-pair ?Ʇ ?ʇ tbl)
 711   (set-case-syntax-pair ?Ʝ ?ʝ tbl)
 712   (set-case-syntax-pair ?Ꭓ ?ꭓ tbl)
 713
 714   ;; Latin Extended-E
 715   (setq c #xAB30)
 716   (while (<= c #xAB64)
 717     (modify-category-entry c ?l)
 718     (setq c (1+ c)))
 719
 720   ;; Greek
 721   (modify-category-entry '(#x0370 . #x03ff) ?g)
 722   (setq c #x0370)
 723   (while (<= c #x03ff)
 724     (if (or (and (>= c #x0391) (<= c #x03a1))
 725             (and (>= c #x03a3) (<= c #x03ab)))
 726         (set-case-syntax-pair c (+ c 32) tbl))
 727     (and (>= c #x03da)
 728          (<= c #x03ee)
 729          (zerop (% c 2))
 730          (set-case-syntax-pair c (1+ c) tbl))
 731     (setq c (1+ c)))
 732   (set-case-syntax-pair ?Ά ?ά tbl)
 733   (set-case-syntax-pair ?Έ ?έ tbl)
 734   (set-case-syntax-pair ?Ή ?ή tbl)
 735   (set-case-syntax-pair ?Ί ?ί tbl)
 736   (set-case-syntax-pair ?Ό ?ό tbl)
 737   (set-case-syntax-pair ?Ύ ?ύ tbl)
 738   (set-case-syntax-pair ?Ώ ?ώ tbl)
 739
 740   ;; Armenian
 741   (setq c #x531)
 742   (while (<= c #x556)
 743     (set-case-syntax-pair c (+ c #x30) tbl)
 744     (setq c (1+ c)))
 745
 746   ;; Greek Extended
 747   (modify-category-entry '(#x1f00 . #x1fff) ?g)
 748   (setq c #x1f00)
 749   (while (<= c #x1fff)
 750     (and (<= (logand c #x000f) 7)
 751          (<= c #x1fa7)
 752          (not (memq c '(#x1f16 #x1f17 #x1f56 #x1f57
 753                                #x1f50 #x1f52 #x1f54 #x1f56)))
 754          (/= (logand c #x00f0) #x70)
 755          (set-case-syntax-pair (+ c 8) c tbl))
 756     (setq c (1+ c)))
 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   (set-case-syntax-pair ?Ῥ ?ῥ tbl)
 776   (set-case-syntax-pair ?Ὸ ?ὸ tbl)
 777   (set-case-syntax-pair ?Ό ?ό tbl)
 778   (set-case-syntax-pair ?Ὼ ?ὼ tbl)
 779   (set-case-syntax-pair ?Ώ ?ώ tbl)
 780   (set-case-syntax-pair ?ῼ ?ῳ tbl)
 781
 782   ;; cyrillic
 783   (modify-category-entry '(#x0400 . #x04FF) ?y)
 784   (setq c #x0400)
 785   (while (<= c #x04ff)
 786     (and (>= c #x0400)
 787          (<= c #x040f)
 788          (set-case-syntax-pair c (+ c 80) tbl))
 789     (and (>= c #x0410)
 790          (<= c #x042f)
 791          (set-case-syntax-pair c (+ c 32) tbl))
 792     (and (zerop (% c 2))
 793          (or (and (>= c #x0460) (<= c #x0480))
 794              (and (>= c #x048c) (<= c #x04be))
 795              (and (>= c #x04d0) (<= c #x052e)))
 796          (set-case-syntax-pair c (1+ c) tbl))
 797     (setq c (1+ c)))
 798   (set-case-syntax-pair ?Ӂ ?ӂ tbl)
 799   (set-case-syntax-pair ?Ӄ ?ӄ tbl)
 800   (set-case-syntax-pair ?Ӈ ?ӈ tbl)
 801   (set-case-syntax-pair ?Ӌ ?ӌ tbl)
 802
 803   (modify-category-entry '(#xA640 . #xA69F) ?y)
 804   (setq c #xA640)
 805   (while (<= c #xA66C)
 806     (set-case-syntax-pair c (+ c 1) tbl)
 807     (setq c (+ c 2)))
 808   (setq c #xA680)
 809   (while (<= c #xA69A)
 810     (set-case-syntax-pair c (+ c 1) tbl)
 811     (setq c (+ c 2)))
 812
 813   ;; Georgian
 814   (setq c #x10A0)
 815   (while (<= c #x10CD)
 816     (set-case-syntax-pair c (+ c #x1C60) tbl)
 817     (setq c (1+ c)))
 818
 819   ;; Cyrillic Extended-C
 820   (modify-category-entry '(#x1C80 . #x1C8F) ?y)
 821
 822   ;; general punctuation
 823   (setq c #x2000)
 824   (while (<= c #x200b)
 825     (set-case-syntax c " " tbl)
 826     (setq c (1+ c)))
 827   (while (<= c #x200F)
 828     (set-case-syntax c "." tbl)
 829     (setq c (1+ c)))
 830   ;; Fixme: These aren't all right:
 831   (setq c #x2010)
 832   (while (<= c #x2016)
 833     (set-case-syntax c "_" tbl)
 834     (setq c (1+ c)))
 835   ;; Punctuation syntax for quotation marks (like `)
 836   (while (<= c #x201f)
 837     (set-case-syntax  c "." tbl)
 838     (setq c (1+ c)))
 839   ;; Fixme: These aren't all right:
 840   (while (<= c #x2027)
 841     (set-case-syntax c "_" tbl)
 842     (setq c (1+ c)))
 843   (while (<= c #x206F)
 844     (set-case-syntax c "." tbl)
 845     (setq c (1+ c)))
 846
 847   ;; Roman numerals
 848   (setq c #x2160)
 849   (while (<= c #x216f)
 850     (set-case-syntax-pair c (+ c #x10) tbl)
 851     (setq c (1+ c)))
 852
 853   ;; Fixme: The following blocks might be better as symbol rather than
 854   ;; punctuation.
 855   ;; Arrows
 856   (setq c #x2190)
 857   (while (<= c #x21FF)
 858     (set-case-syntax c "." tbl)
 859     (setq c (1+ c)))
 860   ;; Mathematical Operators
 861   (while (<= c #x22FF)
 862     (set-case-syntax c "." tbl)
 863     (setq c (1+ c)))
 864   ;; Miscellaneous Technical
 865   (while (<= c #x23FF)
 866     (set-case-syntax c "." tbl)
 867     (setq c (1+ c)))
 868   ;; Control Pictures
 869   (while (<= c #x243F)
 870     (set-case-syntax c "_" tbl)
 871     (setq c (1+ c)))
 872
 873   ;; Circled Latin
 874   (setq c #x24b6)
 875   (while (<= c #x24cf)
 876     (set-case-syntax-pair c (+ c 26) tbl)
 877     (modify-category-entry c ?l)
 878     (modify-category-entry (+ c 26) ?l)
 879     (setq c (1+ c)))
 880
 881   ;; Glagolitic
 882   (setq c #x2C00)
 883   (while (<= c #x2C2E)
 884     (set-case-syntax-pair c (+ c 48) tbl)
 885     (setq c (1+ c)))
 886
 887   ;; Coptic
 888   (let ((pair-ranges '((#x2C80 . #x2CE2)
 889                        (#x2CEB . #x2CF2))))
 890     (dolist (elt pair-ranges)
 891       (let ((from (car elt)) (to (cdr elt)))
 892         (while (< from to)
 893           (set-case-syntax-pair from (1+ from) tbl)
 894           (setq from (+ from 2))))))
 895   ;; There's no Coptic category.  However, Coptic letters that are
 896   ;; part of the Greek block above get the Greek category, and those
 897   ;; in this block are derived from Greek letters, so let's be
 898   ;; consistent about their category.
 899   (modify-category-entry '(#x2C80 . #x2CFF) ?g)
 900
 901   ;; Fullwidth Latin
 902   (setq c #xff21)
 903   (while (<= c #xff3a)
 904     (set-case-syntax-pair c (+ c #x20) tbl)
 905     (modify-category-entry c ?l)
 906     (modify-category-entry (+ c #x20) ?l)
 907     (setq c (1+ c)))
 908
 909   ;; Deseret
 910   (setq c #x10400)
 911   (while (<= c #x10427)
 912     (set-case-syntax-pair c (+ c 28) tbl)
 913     (setq c (1+ c)))
 914
 915   ;; Osage
 916   (setq c #x104B0)
 917   (while (<= c #x104D3)
 918     (set-case-syntax-pair c (+ c 40) tbl)
 919     (setq c (1+ c)))
 920
 921   ;; Old Hungarian
 922   (setq c #x10c80)
 923   (while (<= c #x10cb2)
 924     (set-case-syntax-pair c (+ c #x40) tbl)
 925     (setq c (1+ c)))
 926
 927   ;; Warang Citi
 928   (setq c #x118a0)
 929   (while (<= c #x118bf)
 930     (set-case-syntax-pair c (+ c #x20) tbl)
 931     (setq c (1+ c)))
 932
 933   ;; Adlam
 934   (setq c #x1e900)
 935   (while (<= c #x1e921)
 936     (set-case-syntax-pair c (+ c #x22) tbl)
 937     (setq c (1+ c)))
 938
 939   ;; Combining diacritics
 940   (modify-category-entry '(#x300 . #x362) ?^)
 941   ;; Combining marks
 942   (modify-category-entry '(#x20d0 . #x20ff) ?^)
 943
 944   ;; Fixme: syntax for symbols &c
 945   )
 946
 947 (let ((pairs
 948        '("⁅⁆"                               ; U+2045 U+2046
 949          "⁽⁾"                               ; U+207D U+207E
 950          "₍₎"                               ; U+208D U+208E
 951          "〈〉"                               ; U+2329 U+232A
 952          "⎴⎵"                               ; U+23B4 U+23B5
 953          "❨❩"                               ; U+2768 U+2769
 954          "❪❫"                               ; U+276A U+276B
 955          "❬❭"                               ; U+276C U+276D
 956          "❰❱"                               ; U+2770 U+2771
 957          "❲❳"                               ; U+2772 U+2773
 958          "❴❵"                               ; U+2774 U+2775
 959          "⟦⟧"                               ; U+27E6 U+27E7
 960          "⟨⟩"                               ; U+27E8 U+27E9
 961          "⟪⟫"                               ; U+27EA U+27EB
 962          "⦃⦄"                               ; U+2983 U+2984
 963          "⦅⦆"                               ; U+2985 U+2986
 964          "⦇⦈"                               ; U+2987 U+2988
 965          "⦉⦊"                               ; U+2989 U+298A
 966          "⦋⦌"                               ; U+298B U+298C
 967          "⦍⦎"                               ; U+298D U+298E
 968          "⦏⦐"                               ; U+298F U+2990
 969          "⦑⦒"                               ; U+2991 U+2992
 970          "⦓⦔"                               ; U+2993 U+2994
 971          "⦕⦖"                               ; U+2995 U+2996
 972          "⦗⦘"                               ; U+2997 U+2998
 973          "⧼⧽"                               ; U+29FC U+29FD
 974          "〈〉"                               ; U+3008 U+3009
 975          "《》"                               ; U+300A U+300B
 976          "「」"                               ; U+300C U+300D
 977          "『』"                               ; U+300E U+300F
 978          "【】"                               ; U+3010 U+3011
 979          "〔〕"                               ; U+3014 U+3015
 980          "〖〗"                               ; U+3016 U+3017
 981          "〘〙"                               ; U+3018 U+3019
 982          "〚〛"                               ; U+301A U+301B
 983          "﴾﴿"                               ; U+FD3E U+FD3F
 984          "︵︶"                               ; U+FE35 U+FE36
 985          "︷︸"                               ; U+FE37 U+FE38
 986          "︹︺"                               ; U+FE39 U+FE3A
 987          "︻︼"                               ; U+FE3B U+FE3C
 988          "︽︾"                               ; U+FE3D U+FE3E
 989          "︿﹀"                               ; U+FE3F U+FE40
 990          "﹁﹂"                               ; U+FE41 U+FE42
 991          "﹃﹄"                               ; U+FE43 U+FE44
 992          "﹙﹚"                               ; U+FE59 U+FE5A
 993          "﹛﹜"                               ; U+FE5B U+FE5C
 994          "﹝﹞"                               ; U+FE5D U+FE5E
 995          "（）"                               ; U+FF08 U+FF09
 996          "［］"                               ; U+FF3B U+FF3D
 997          "｛｝"                               ; U+FF5B U+FF5D
 998          "｟｠"                               ; U+FF5F U+FF60
 999          "｢｣"                               ; U+FF62 U+FF63
1000          )))
1001   (dolist (elt pairs)
1002     (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
1003     (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
1004
1005 \f
1006 ;; For each character set, put the information of the most proper
1007 ;; coding system to encode it by `preferred-coding-system' property.
1008
1009 ;; Fixme: should this be junked?
1010 (let ((l '((latin-iso8859-1     . iso-latin-1)
1011            (latin-iso8859-2     . iso-latin-2)
1012            (latin-iso8859-3     . iso-latin-3)
1013            (latin-iso8859-4     . iso-latin-4)
1014            (thai-tis620         . thai-tis620)
1015            (greek-iso8859-7     . greek-iso-8bit)
1016            (arabic-iso8859-6    . iso-2022-7bit)
1017            (hebrew-iso8859-8    . hebrew-iso-8bit)
1018            (katakana-jisx0201   . japanese-shift-jis)
1019            (latin-jisx0201      . japanese-shift-jis)
1020            (cyrillic-iso8859-5  . cyrillic-iso-8bit)
1021            (latin-iso8859-9     . iso-latin-5)
1022            (japanese-jisx0208-1978 . iso-2022-jp)
1023            (chinese-gb2312      . chinese-iso-8bit)
1024            (chinese-gbk         . chinese-gbk)
1025            (gb18030-2-byte      . chinese-gb18030)
1026            (gb18030-4-byte-bmp  . chinese-gb18030)
1027            (gb18030-4-byte-smp  . chinese-gb18030)
1028            (gb18030-4-byte-ext-1 . chinese-gb18030)
1029            (gb18030-4-byte-ext-2 . chinese-gb18030)
1030            (japanese-jisx0208   . iso-2022-jp)
1031            (korean-ksc5601      . iso-2022-kr)
1032            (japanese-jisx0212   . iso-2022-jp)
1033            (chinese-big5-1      . chinese-big5)
1034            (chinese-big5-2      . chinese-big5)
1035            (chinese-sisheng     . iso-2022-7bit)
1036            (ipa                 . iso-2022-7bit)
1037            (vietnamese-viscii-lower . vietnamese-viscii)
1038            (vietnamese-viscii-upper . vietnamese-viscii)
1039            (arabic-digit        . iso-2022-7bit)
1040            (arabic-1-column     . iso-2022-7bit)
1041            (lao                 . lao)
1042            (arabic-2-column     . iso-2022-7bit)
1043            (indian-is13194      . devanagari)
1044            (indian-glyph        . devanagari)
1045            (tibetan-1-column    . tibetan)
1046            (ethiopic            . iso-2022-7bit)
1047            (chinese-cns11643-1  . iso-2022-cn)
1048            (chinese-cns11643-2  . iso-2022-cn)
1049            (chinese-cns11643-3  . iso-2022-cn)
1050            (chinese-cns11643-4  . iso-2022-cn)
1051            (chinese-cns11643-5  . iso-2022-cn)
1052            (chinese-cns11643-6  . iso-2022-cn)
1053            (chinese-cns11643-7  . iso-2022-cn)
1054            (indian-2-column     . devanagari)
1055            (tibetan             . tibetan)
1056            (latin-iso8859-14    . iso-latin-8)
1057            (latin-iso8859-15    . iso-latin-9))))
1058   (while l
1059     (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
1060     (setq l (cdr l))))
1061
1062 \f
1063 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
1064 ;; SPACE and NEWLINE are already set.
1065
1066 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
1067 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
1068 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
1069 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
1070 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
1071 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
1072
1073 \f
1074 ;;; Setting char-width-table.  The default is 1.
1075
1076 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
1077 ;;    and final characters.
1078 (let ((l '((#x0300 . #x036F)
1079            (#x0483 . #x0489)
1080            (#x0591 . #x05BD)
1081            (#x05BF . #x05BF)
1082            (#x05C1 . #x05C2)
1083            (#x05C4 . #x05C5)
1084            (#x05C7 . #x05C7)
1085            (#x0600 . #x0603)
1086            (#x0610 . #x0615)
1087            (#x064B . #x065E)
1088            (#x0670 . #x0670)
1089            (#x06D6 . #x06E4)
1090            (#x06E7 . #x06E8)
1091            (#x06EA . #x06ED)
1092            (#x070F . #x070F)
1093            (#x0711 . #x0711)
1094            (#x0730 . #x074A)
1095            (#x07A6 . #x07B0)
1096            (#x07EB . #x07F3)
1097            (#x0901 . #x0902)
1098            (#x093C . #x093C)
1099            (#x0941 . #x0948)
1100            (#x094D . #x094D)
1101            (#x0951 . #x0954)
1102            (#x0962 . #x0963)
1103            (#x0981 . #x0981)
1104            (#x09BC . #x09BC)
1105            (#x09C1 . #x09C4)
1106            (#x09CD . #x09CD)
1107            (#x09E2 . #x09E3)
1108            (#x0A01 . #x0A02)
1109            (#x0A3C . #x0A3C)
1110            (#x0A41 . #x0A4D)
1111            (#x0A70 . #x0A71)
1112            (#x0A81 . #x0A82)
1113            (#x0ABC . #x0ABC)
1114            (#x0AC1 . #x0AC8)
1115            (#x0ACD . #x0ACD)
1116            (#x0AE2 . #x0AE3)
1117            (#x0B01 . #x0B01)
1118            (#x0B3C . #x0B3C)
1119            (#x0B3F . #x0B3F)
1120            (#x0B41 . #x0B43)
1121            (#x0B4D . #x0B56)
1122            (#x0B82 . #x0B82)
1123            (#x0BC0 . #x0BC0)
1124            (#x0BCD . #x0BCD)
1125            (#x0C3E . #x0C40)
1126            (#x0C46 . #x0C56)
1127            (#x0CBC . #x0CBC)
1128            (#x0CBF . #x0CBF)
1129            (#x0CC6 . #x0CC6)
1130            (#x0CCC . #x0CCD)
1131            (#x0CE2 . #x0CE3)
1132            (#x0D41 . #x0D43)
1133            (#x0D4D . #x0D4D)
1134            (#x0DCA . #x0DCA)
1135            (#x0DD2 . #x0DD6)
1136            (#x0E31 . #x0E31)
1137            (#x0E34 . #x0E3A)
1138            (#x0E47 . #x0E4E)
1139            (#x0EB1 . #x0EB1)
1140            (#x0EB4 . #x0EBC)
1141            (#x0EC8 . #x0ECD)
1142            (#x0F18 . #x0F19)
1143            (#x0F35 . #x0F35)
1144            (#x0F37 . #x0F37)
1145            (#x0F39 . #x0F39)
1146            (#x0F71 . #x0F7E)
1147            (#x0F80 . #x0F84)
1148            (#x0F86 . #x0F87)
1149            (#x0F90 . #x0FBC)
1150            (#x0FC6 . #x0FC6)
1151            (#x102D . #x1030)
1152            (#x1032 . #x1037)
1153            (#x1039 . #x1039)
1154            (#x1058 . #x1059)
1155            (#x1160 . #x11FF)
1156            (#x135F . #x135F)
1157            (#x1712 . #x1714)
1158            (#x1732 . #x1734)
1159            (#x1752 . #x1753)
1160            (#x1772 . #x1773)
1161            (#x17B4 . #x17B5)
1162            (#x17B7 . #x17BD)
1163            (#x17C6 . #x17C6)
1164            (#x17C9 . #x17D3)
1165            (#x17DD . #x17DD)
1166            (#x180B . #x180D)
1167            (#x18A9 . #x18A9)
1168            (#x1920 . #x1922)
1169            (#x1927 . #x1928)
1170            (#x1932 . #x1932)
1171            (#x1939 . #x193B)
1172            (#x1A17 . #x1A18)
1173            (#x1B00 . #x1B03)
1174            (#x1B34 . #x1B34)
1175            (#x1B36 . #x1B3A)
1176            (#x1B3C . #x1B3C)
1177            (#x1B42 . #x1B42)
1178            (#x1B6B . #x1B73)
1179            (#x1DC0 . #x1DFF)
1180            (#x200B . #x200F)
1181            (#x202A . #x202E)
1182            (#x2060 . #x206F)
1183            (#x20D0 . #x20EF)
1184            (#x302A . #x302F)
1185            (#x3099 . #x309A)
1186            (#xA806 . #xA806)
1187            (#xA80B . #xA80B)
1188            (#xA825 . #xA826)
1189            (#xFB1E . #xFB1E)
1190            (#xFE00 . #xFE0F)
1191            (#xFE20 . #xFE23)
1192            (#xFEFF . #xFEFF)
1193            (#xFFF9 . #xFFFB)
1194            (#x10A01 . #x10A0F)
1195            (#x10A38 . #x10A3F)
1196            (#x1D167 . #x1D169)
1197            (#x1D173 . #x1D182)
1198            (#x1D185 . #x1D18B)
1199            (#x1D1AA . #x1D1AD)
1200            (#x1D242 . #x1D244)
1201            (#xE0001 . #xE01EF))))
1202   (dolist (elt l)
1203     (set-char-table-range char-width-table elt 0)))
1204
1205 ;; 2: East Asian Wide and Full-width characters.
1206 (let ((l '((#x1100 . #x115F)
1207            (#x231A . #x231B)
1208            (#x2329 . #x232A)
1209            (#x23E9 . #x23EC)
1210            (#x23F0 . #x23F0)
1211            (#x23F3 . #x23F3)
1212            (#x25FD . #x25FE)
1213            (#x2614 . #x2615)
1214            (#x2648 . #x2653)
1215            (#x267F . #x267F)
1216            (#x2693 . #x2693)
1217            (#x26A1 . #x26A1)
1218            (#x26AA . #x26AB)
1219            (#x26BD . #x26BE)
1220            (#x26C4 . #x26C5)
1221            (#x26CE . #x26CE)
1222            (#x26D4 . #x26D4)
1223            (#x26EA . #x26EA)
1224            (#x26F2 . #x26F3)
1225            (#x26F5 . #x26F5)
1226            (#x26FA . #x26FA)
1227            (#x26FD . #x26FD)
1228            (#x2705 . #x2705)
1229            (#x270A . #x270B)
1230            (#x2728 . #x2728)
1231            (#x274C . #x274C)
1232            (#x274E . #x274E)
1233            (#x2753 . #x2755)
1234            (#x2757 . #x2757)
1235            (#x2795 . #x2797)
1236            (#x27B0 . #x27B0)
1237            (#x27BF . #x27BF)
1238            (#x2B1B . #x2B1C)
1239            (#x2B50 . #x2B50)
1240            (#x2B55 . #x2B55)
1241            (#x2E80 . #x303E)
1242            (#x3040 . #xA4CF)
1243            (#xAC00 . #xD7A3)
1244            (#xF900 . #xFAFF)
1245            (#xFE30 . #xFE6F)
1246            (#xFF01 . #xFF60)
1247            (#xFFE0 . #xFFE6)
1248            (#x16FE0 . #x16FE0)
1249            (#x17000 . #x187EC)
1250            (#x18800 . #x18AF2)
1251            (#x1F18E . #x1F18E)
1252            (#x1F191 . #x1F19A)
1253            (#x1F200 . #x1F202)
1254            (#x1F210 . #x1F23B)
1255            (#x1F300 . #x1F320)
1256            (#x1F32D . #x1F335)
1257            (#x1F337 . #x1F37C)
1258            (#x1F37E . #x1F393)
1259            (#x1F3A0 . #x1F3CA)
1260            (#x1F3CF . #x1F3D3)
1261            (#x1F3E0 . #x1F3F0)
1262            (#x1F3F4 . #x1F3F4)
1263            (#x1F3F8 . #x1F3FA)
1264            (#x1F3FB . #x1F3FF)
1265            (#x1F440 . #x1F440)
1266            (#x1F442 . #x1F4FC)
1267            (#x1F4FF . #x1F53D)
1268            (#x1F54B . #x1F54E)
1269            (#x1F550 . #x1F567)
1270            (#x1F57A . #x1F57A)
1271            (#x1F595 . #x1F596)
1272            (#x1F5A4 . #x1F5A4)
1273            (#x1F5FB . #x1F5FF)
1274            (#x1F600 . #x1F64F)
1275            (#x1F680 . #x1F6C5)
1276            (#x1F6CC . #x1F6CC)
1277            (#x1F6D0 . #x1F6D2)
1278            (#x1F6EB . #x1F6EC)
1279            (#x1F6F4 . #x1F6F6)
1280            (#x1F910 . #x1F91E)
1281            (#x1F920 . #x1F927)
1282            (#x1F930 . #x1F930)
1283            (#x1F933 . #x1F93E)
1284            (#x1F940 . #x1F94B)
1285            (#x1F950 . #x1F95E)
1286            (#x1F980 . #x1F991)
1287            (#x1F9C0 . #x1F9C0)
1288            (#x20000 . #x2FFFF)
1289            (#x30000 . #x3FFFF))))
1290   (dolist (elt l)
1291     (set-char-table-range char-width-table elt 2)))
1292
1293 ;; Other double width
1294 ;;(map-charset-chars
1295 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1296 ;; 'ethiopic)
1297 ;; (map-charset-chars
1298 ;;  (lambda (range ignore) (set-char-table-range char-width-table range 2))
1299 ;; 'tibetan)
1300 (map-charset-chars
1301  (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1302  'indian-2-column)
1303 (map-charset-chars
1304  (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1305  'arabic-2-column)
1306
1307 ;; Internal use only.
1308 ;; Alist of locale symbol vs charsets.  In a language environment
1309 ;; corresponding to the locale, width of characters in the charsets is
1310 ;; set to 2.  Each element has the form:
1311 ;;   (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1312 ;; LOCALE: locale symbol
1313 ;; TABLE: char-table used for char-width-table, initially nil.
1314 ;; CHARSET: character set
1315 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1316
1317 (defvar cjk-char-width-table-list
1318   '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1319                (cp932-2-byte (#x8140 . #x879F)))
1320     (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1321     (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1322     (zh_TW nil (big5 (#xA140 . #xA3FE))
1323                (chinese-cns11643-1 (#x2121 . #x427E)))
1324     (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1325
1326 ;; Internal use only.
1327 ;; Setup char-width-table appropriate for a language environment
1328 ;; corresponding to LOCALE-NAME (symbol).
1329
1330 (defun use-cjk-char-width-table (locale-name)
1331   (while (char-table-parent char-width-table)
1332     (setq char-width-table (char-table-parent char-width-table)))
1333   (let ((slot (assq locale-name cjk-char-width-table-list)))
1334     (or slot (error "Unknown locale for CJK language environment: %s"
1335                     locale-name))
1336     (unless (nth 1 slot)
1337       (let ((table (make-char-table nil)))
1338         (dolist (charset-info (nthcdr 2 slot))
1339           (let ((charset (car charset-info)))
1340             (dolist (code-range (cdr charset-info))
1341               (map-charset-chars #'(lambda (range _arg)
1342                                      (set-char-table-range table range 2))
1343                                  charset nil
1344                                  (car code-range) (cdr code-range)))))
1345         (optimize-char-table table)
1346         (set-char-table-parent table char-width-table)
1347         (setcar (cdr slot) table)))
1348     (setq char-width-table (nth 1 slot))))
1349
1350 (defun use-default-char-width-table ()
1351   "Internal use only.
1352 Setup char-width-table appropriate for non-CJK language environment."
1353   (while (char-table-parent char-width-table)
1354     (setq char-width-table (char-table-parent char-width-table))))
1355
1356 (optimize-char-table (standard-case-table))
1357 (optimize-char-table (standard-syntax-table))
1358
1359 \f
1360 ;; Setting char-script-table.
1361 (if purify-flag
1362     ;; While dumping, we can't use require, and international is not
1363     ;; in load-path.
1364     (load "international/charscript")
1365   (require 'charscript))
1366
1367 (map-charset-chars
1368  #'(lambda (range _ignore)
1369      (set-char-table-range char-script-table range 'tibetan))
1370  'tibetan)
1371
1372 \f
1373 ;;; Setting unicode-category-table.
1374
1375 (when (setq unicode-category-table
1376             (unicode-property-table-internal 'general-category))
1377   (map-char-table #'(lambda (key val)
1378                       (if val
1379                           (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
1380                                           (/= (aref (symbol-name val) 0) ?C))
1381                                      (eq val 'Zs))
1382                                  (modify-category-entry key ?.))
1383                                 ((eq val 'Mn)
1384                                  (modify-category-entry key ?^)))))
1385                   unicode-category-table))
1386
1387 (optimize-char-table (standard-category-table))
1388
1389 \f
1390 ;; Display of glyphless characters.
1391
1392 (defvar char-acronym-table
1393   (make-char-table 'char-acronym-table nil)
1394   "Char table of acronyms for non-graphic characters.")
1395
1396 (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
1397                      "BS"   nil   nil  "VT"  "FF"  "CR"  "SO"  "SI"
1398                      "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
1399                      "CAN" "EM"  "SUB" "ESC" "FC"  "GS"  "RS"  "US")))
1400   (dotimes (i 32)
1401     (aset char-acronym-table i (car c0-acronyms))
1402     (setq c0-acronyms (cdr c0-acronyms))))
1403
1404 (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA"
1405                      "HTS" "HTJ" "VTS" "PLD" "PLU" "R1"  "SS2" "SS1"
1406                      "DCS" "PU1" "PU2" "STS" "CCH" "MW"  "SPA" "EPA"
1407                      "SOS" "SGCI" "SC1" "CSI" "ST"  "OSC" "PM"  "APC")))
1408   (dotimes (i 32)
1409     (aset char-acronym-table (+ #x0080 i) (car c1-acronyms))
1410     (setq c1-acronyms (cdr c1-acronyms))))
1411
1412 (aset char-acronym-table #x17B4 "KIVAQ")   ; KHMER VOWEL INHERENT AQ
1413 (aset char-acronym-table #x17B5 "KIVAA")   ; KHMER VOWEL INHERENT AA
1414 (aset char-acronym-table #x200B "ZWSP")    ; ZERO WIDTH SPACE
1415 (aset char-acronym-table #x200C "ZWNJ")    ; ZERO WIDTH NON-JOINER
1416 (aset char-acronym-table #x200D "ZWJ")     ; ZERO WIDTH JOINER
1417 (aset char-acronym-table #x200E "LRM")     ; LEFT-TO-RIGHT MARK
1418 (aset char-acronym-table #x200F "RLM")     ; RIGHT-TO-LEFT MARK
1419 (aset char-acronym-table #x202A "LRE")     ; LEFT-TO-RIGHT EMBEDDING
1420 (aset char-acronym-table #x202B "RLE")     ; RIGHT-TO-LEFT EMBEDDING
1421 (aset char-acronym-table #x202C "PDF")     ; POP DIRECTIONAL FORMATTING
1422 (aset char-acronym-table #x202D "LRO")     ; LEFT-TO-RIGHT OVERRIDE
1423 (aset char-acronym-table #x202E "RLO")     ; RIGHT-TO-LEFT OVERRIDE
1424 (aset char-acronym-table #x2060 "WJ")      ; WORD JOINER
1425 (aset char-acronym-table #x206A "ISS")     ; INHIBIT SYMMETRIC SWAPPING
1426 (aset char-acronym-table #x206B "ASS")     ; ACTIVATE SYMMETRIC SWAPPING
1427 (aset char-acronym-table #x206C "IAFS")    ; INHIBIT ARABIC FORM SHAPING
1428 (aset char-acronym-table #x206D "AAFS")    ; ACTIVATE ARABIC FORM SHAPING
1429 (aset char-acronym-table #x206E "NADS")    ; NATIONAL DIGIT SHAPES
1430 (aset char-acronym-table #x206F "NODS")    ; NOMINAL DIGIT SHAPES
1431 (aset char-acronym-table #xFEFF "ZWNBSP")  ; ZERO WIDTH NO-BREAK SPACE
1432 (aset char-acronym-table #xFFF9 "IAA")     ; INTERLINEAR ANNOTATION ANCHOR
1433 (aset char-acronym-table #xFFFA "IAS")     ; INTERLINEAR ANNOTATION SEPARATOR
1434 (aset char-acronym-table #xFFFB "IAT")     ; INTERLINEAR ANNOTATION TERMINATOR
1435 (aset char-acronym-table #x1D173 "BEGBM")  ; MUSICAL SYMBOL BEGIN BEAM
1436 (aset char-acronym-table #x1D174 "ENDBM")  ; MUSICAL SYMBOL END BEAM
1437 (aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE
1438 (aset char-acronym-table #x1D176 "END")    ; MUSICAL SYMBOL END TIE
1439 (aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR
1440 (aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR
1441 (aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE
1442 (aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE
1443 (aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG
1444 (aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE
1445 (dotimes (i 94)
1446   (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
1447 (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
1448
1449 (defun update-glyphless-char-display (&optional variable value)
1450   "Make the setting of `glyphless-char-display-control' take effect.
1451 This function updates the char-table `glyphless-char-display'."
1452   (when value
1453     (set-default variable value))
1454   (dolist (elt value)
1455     (let ((target (car elt))
1456           (method (cdr elt)))
1457       (or (memq method '(zero-width thin-space empty-box acronym hex-code))
1458           (error "Invalid glyphless character display method: %s" method))
1459       (cond ((eq target 'c0-control)
1460              (glyphless-set-char-table-range glyphless-char-display
1461                                              #x00 #x1F method)
1462              ;; Users will not expect their newlines and TABs be
1463              ;; displayed as anything but themselves, so exempt those
1464              ;; two characters from c0-control.
1465              (set-char-table-range glyphless-char-display #x9 nil)
1466              (set-char-table-range glyphless-char-display #xa nil))
1467             ((eq target 'c1-control)
1468              (glyphless-set-char-table-range glyphless-char-display
1469                                              #x80 #x9F method))
1470             ((eq target 'format-control)
1471              (when unicode-category-table
1472                (map-char-table
1473                 #'(lambda (char category)
1474                     (if (eq category 'Cf)
1475                         (let ((this-method method)
1476                               from to)
1477                           (if (consp char)
1478                               (setq from (car char) to (cdr char))
1479                             (setq from char to char))
1480                           (while (<= from to)
1481                             (when (/= from #xAD)
1482                               (if (eq method 'acronym)
1483                                   (setq this-method
1484                                         (aref char-acronym-table from)))
1485                               (set-char-table-range glyphless-char-display
1486                                                     from this-method))
1487                             (setq from (1+ from))))))
1488                 unicode-category-table)))
1489             ((eq target 'no-font)
1490              (set-char-table-extra-slot glyphless-char-display 0 method))
1491             (t
1492              (error "Invalid glyphless character group: %s" target))))))
1493
1494 (defun glyphless-set-char-table-range (chartable from to method)
1495   (if (eq method 'acronym)
1496       (let ((i from))
1497         (while (<= i to)
1498           (set-char-table-range chartable i (aref char-acronym-table i))
1499           (setq i (1+ i))))
1500     (set-char-table-range chartable (cons from to) method)))
1501
1502 ;;; Control of displaying glyphless characters.
1503 (defcustom glyphless-char-display-control
1504   '((format-control . thin-space)
1505     (no-font . hex-code))
1506   "List of directives to control display of glyphless characters.
1507
1508 Each element has the form (GROUP . METHOD), where GROUP is a
1509 symbol specifying the character group, and METHOD is a symbol
1510 specifying the method of displaying characters belonging to that
1511 group.
1512
1513 GROUP must be one of these symbols:
1514   `c0-control':     U+0000..U+001F, but excluding newline and TAB.
1515   `c1-control':     U+0080..U+009F.
1516   `format-control': Characters of Unicode General Category `Cf',
1517                     such as U+200C (ZWNJ), U+200E (LRM), but
1518                     excluding characters that have graphic images,
1519                     such as U+00AD (SHY).
1520   `no-font':        characters for which no suitable font is found.
1521                     For character terminals, characters that cannot
1522                     be encoded by `terminal-coding-system'.
1523
1524 METHOD must be one of these symbols:
1525   `zero-width': don't display.
1526   `thin-space': display a thin (1-pixel width) space.  On character
1527                 terminals, display as 1-character space.
1528   `empty-box':  display an empty box.
1529   `acronym':    display an acronym of the character in a box.  The
1530                 acronym is taken from `char-acronym-table', which see.
1531   `hex-code':   display the hexadecimal character code in a box.
1532
1533 Do not set its value directly from Lisp; the value takes effect
1534 only via a custom `:set'
1535 function (`update-glyphless-char-display'), which updates
1536 `glyphless-char-display'."
1537   :version "24.1"
1538   :type '(alist :key-type (symbol :tag "Character Group")
1539                 :value-type (symbol :tag "Display Method"))
1540   :options '((c0-control
1541               (choice (const :tag "Don't display" zero-width)
1542                       (const :tag "Display as thin space" thin-space)
1543                       (const :tag "Display as empty box" empty-box)
1544                       (const :tag "Display acronym" acronym)
1545                       (const :tag "Display hex code in a box" hex-code)))
1546              (c1-control
1547               (choice (const :tag "Don't display" zero-width)
1548                       (const :tag "Display as thin space" thin-space)
1549                       (const :tag "Display as empty box" empty-box)
1550                       (const :tag "Display acronym" acronym)
1551                       (const :tag "Display hex code in a box" hex-code)))
1552              (format-control
1553               (choice (const :tag "Don't display" zero-width)
1554                       (const :tag "Display as thin space" thin-space)
1555                       (const :tag "Display as empty box" empty-box)
1556                       (const :tag "Display acronym" acronym)
1557                       (const :tag "Display hex code in a box" hex-code)))
1558              (no-font
1559               (choice (const :tag "Don't display" zero-width)
1560                       (const :tag "Display as thin space" thin-space)
1561                       (const :tag "Display as empty box" empty-box)
1562                       (const :tag "Display acronym" acronym)
1563                       (const :tag "Display hex code in a box" hex-code))))
1564   :set 'update-glyphless-char-display
1565   :group 'display)
1566
1567 \f
1568 ;;; Setting word boundary.
1569
1570 (setq word-combining-categories
1571       '((nil . ?^)
1572         (?^ . nil)
1573         (?C . ?H)
1574         (?C . ?K)))
1575
1576 (setq word-separating-categories        ;  (2-byte character sets)
1577       '((?H . ?K)                       ; Hiragana - Katakana
1578         ))
1579
1580 ;; Local Variables:
1581 ;; coding: utf-8
1582 ;; End:
1583
1584 ;;; characters.el ends here