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 '(#x8a0 . #x8ff) ?b)
 294 (modify-category-entry '(#xfb50 . #xfdff) ?b)
 295 (modify-category-entry '(#xfe70 . #xfefe) ?b)
 296
 297 ;; Cyrillic character set (ISO-8859-5)
 298
 299 (modify-syntax-entry ?№ ".")
 300
 301 ;; Ethiopic character set
 302
 303 (modify-category-entry '(#x1200 . #x1399) ?e)
 304 (modify-category-entry '(#x2d80 . #x2dde) ?e)
 305 (let ((chars '(?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨)))
 306   (while chars
 307     (modify-syntax-entry (car chars) ".")
 308     (setq chars (cdr chars))))
 309 (map-charset-chars #'modify-category-entry 'ethiopic ?e)
 310
 311 ;; Hebrew character set (ISO-8859-8)
 312
 313 (modify-syntax-entry #x5be ".") ; MAQAF
 314 (modify-syntax-entry #x5c0 ".") ; PASEQ
 315 (modify-syntax-entry #x5c3 ".") ; SOF PASUQ
 316 (modify-syntax-entry #x5f3 ".") ; GERESH
 317 (modify-syntax-entry #x5f4 ".") ; GERSHAYIM
 318
 319 ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
 320
 321 (modify-category-entry '(#x901 . #x970) ?i)
 322 (map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
 323 (map-charset-chars #'modify-category-entry 'indian-2-column ?i)
 324
 325 ;; Lao character set
 326
 327 (modify-category-entry '(#xe80 . #xeff) ?o)
 328 (map-charset-chars #'modify-category-entry 'lao ?o)
 329
 330 (let ((deflist  '(("ກ-ຮ"    "w"     ?0) ; consonant
 331                   ("ະາຳຽເ-ໄ"        "w"     ?1) ; vowel base
 332                   ("ັິ-ືົໍ"   "w"     ?2) ; vowel upper
 333                   ("ຸູ"     "w"     ?3) ; vowel lower
 334                   ("່-໋"    "w"     ?4) ; tone mark
 335                   ("ຼຽ"     "w"     ?9) ; semivowel lower
 336                   ("໐-໙"    "w"     ?6) ; digit
 337                   ("ຯໆ"     "_"     ?5) ; symbol
 338                   ))
 339       elm chars len syntax category to ch i)
 340   (while deflist
 341     (setq elm (car deflist))
 342     (setq chars (car elm)
 343           len (length chars)
 344           syntax (nth 1 elm)
 345           category (nth 2 elm)
 346           i 0)
 347     (while (< i len)
 348       (if (= (aref chars i) ?-)
 349           (setq i (1+ i)
 350                 to (aref chars i))
 351         (setq ch (aref chars i)
 352               to ch))
 353       (while (<= ch to)
 354         (unless (string-equal syntax "w")
 355           (modify-syntax-entry ch syntax))
 356         (modify-category-entry ch category)
 357         (setq ch (1+ ch)))
 358       (setq i (1+ i)))
 359     (setq deflist (cdr deflist))))
 360
 361 ;; Thai character set (TIS620)
 362
 363 (modify-category-entry '(#xe00 . #xe7f) ?t)
 364 (map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
 365
 366 (let ((deflist  '(;; chars      syntax  category
 367                   ("ก-รลว-ฮ"  "w"     ?0) ; consonant
 368                   ("ฤฦะาำเ-ๅ"     "w"     ?1) ; vowel base
 369                   ("ัิ-ื็๎"   "w"     ?2) ; vowel upper
 370                   ("ุ-ฺ"    "w"     ?3) ; vowel lower
 371                   ("่-ํ"    "w"     ?4) ; tone mark
 372                   ("๐-๙"    "w"     ?6) ; digit
 373                   ("ฯๆ฿๏๚๛" "_"     ?5) ; symbol
 374                   ))
 375       elm chars len syntax category to ch i)
 376   (while deflist
 377     (setq elm (car deflist))
 378     (setq chars (car elm)
 379           len (length chars)
 380           syntax (nth 1 elm)
 381           category (nth 2 elm)
 382           i 0)
 383     (while (< i len)
 384       (if (= (aref chars i) ?-)
 385           (setq i (1+ i)
 386                 to (aref chars i))
 387         (setq ch (aref chars i)
 388               to ch))
 389       (while (<= ch to)
 390         (unless (string-equal syntax "w")
 391           (modify-syntax-entry ch syntax))
 392         (modify-category-entry ch category)
 393         (setq ch (1+ ch)))
 394       (setq i (1+ i)))
 395     (setq deflist (cdr deflist))))
 396
 397 ;; Tibetan character set
 398
 399 (modify-category-entry '(#xf00 . #xfff) ?q)
 400 (map-charset-chars #'modify-category-entry 'tibetan ?q)
 401 (map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
 402
 403 (let ((deflist  '(;; chars             syntax category
 404                   ("ཀ-ཀྵཪ"         "w"     ?0) ; consonant
 405                   ("ྐ-ྐྵྺྻྼ"       "w"     ?0) ;
 406                   ("ིེཻོཽྀ"       "w"       ?2) ; upper vowel
 407                   ("ཾྂྃ྆྇ྈྉྊྋ" "w"    ?2) ; upper modifier
 408                   ("྄ཱུ༙༵༷"       "w"       ?3) ; lower vowel/modifier
 409                   ("཰"                "w" ?3)             ; invisible vowel a
 410                   ("༠-༩༪-༳"             "w"     ?6) ; digit
 411                   ("་།-༒༔ཿ"        "."     ?|) ; line-break char
 412                   ("་།༏༐༑༔ཿ"            "."     ?|) ;
 413                   ("༈་།-༒༔ཿ༽༴"  "."     ?>) ; prohibition
 414                   ("་།༏༐༑༔ཿ"            "."     ?>) ;
 415                   ("ༀ-༊༼࿁࿂྅"      "."     ?<) ; prohibition
 416                   ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
 417                   ))
 418       elm chars len syntax category to ch i)
 419   (while deflist
 420     (setq elm (car deflist))
 421     (setq chars (car elm)
 422           len (length chars)
 423           syntax (nth 1 elm)
 424           category (nth 2 elm)
 425           i 0)
 426     (while (< i len)
 427       (if (= (aref chars i) ?-)
 428           (setq i (1+ i)
 429                 to (aref chars i))
 430         (setq ch (aref chars i)
 431               to ch))
 432       (while (<= ch to)
 433         (unless (string-equal syntax "w")
 434           (modify-syntax-entry ch syntax))
 435         (modify-category-entry ch category)
 436         (setq ch (1+ ch)))
 437       (setq i (1+ i)))
 438     (setq deflist (cdr deflist))))
 439
 440 ;; Vietnamese character set
 441
 442 ;; To make a word with Latin characters
 443 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
 444 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
 445
 446 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
 447 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
 448
 449 (let ((tbl (standard-case-table))
 450       (i 32))
 451   (while (< i 128)
 452     (let* ((char (decode-char 'vietnamese-viscii-upper i))
 453            (charl (decode-char 'vietnamese-viscii-lower i))
 454            (uc (encode-char char 'ucs))
 455            (lc (encode-char charl 'ucs)))
 456       (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
 457                             tbl)
 458       (if uc (modify-category-entry uc ?v))
 459       (if lc (modify-category-entry lc ?v)))
 460     (setq i (1+ i))))
 461
 462 ;; Tai Viet
 463 (let ((deflist '(;; chars       syntax  category
 464                  ((?ꪀ.  ?ꪯ) "w"     ?0) ; consonant
 465                  ("ꪱꪵꪶ"           "w"     ?1) ; vowel base
 466                  ((?ꪹ . ?ꪽ) "w"     ?1) ; vowel base
 467                  ("ꪰꪲꪳꪷꪸꪾ"  "w"     ?2) ; vowel upper
 468                  ("ꪴ"         "w"     ?3) ; vowel lower
 469                  ("ꫀꫂ"              "w"     ?1) ; non-combining tone-mark
 470                  ("꪿꫁"              "w"     ?4) ; combining tone-mark
 471                  ((?ꫛ . ?꫟) "_"     ?5) ; symbol
 472                  )))
 473   (dolist (elm deflist)
 474     (let ((chars (car elm))
 475           (syntax (nth 1 elm))
 476           (category (nth 2 elm)))
 477       (if (consp chars)
 478           (progn
 479             (modify-syntax-entry chars syntax)
 480             (modify-category-entry chars category))
 481         (mapc #'(lambda (x)
 482                   (modify-syntax-entry x syntax)
 483                   (modify-category-entry x category))
 484               chars)))))
 485
 486 ;; Bidi categories
 487
 488 ;; If bootstrapping without generated uni-*.el files, table not defined.
 489 (let ((table (unicode-property-table-internal 'bidi-class)))
 490   (when table
 491     (map-char-table (lambda (key val)
 492                       (cond
 493                        ((memq val '(R AL RLO RLE))
 494                         (modify-category-entry key ?R))
 495                        ((memq val '(L LRE LRO))
 496                         (modify-category-entry key ?L))))
 497                     table)))
 498
 499 ;; Load uni-mirrored.el and uni-brackets.el if available, so that they
 500 ;; get dumped into Emacs.  This allows starting Emacs with
 501 ;; force-load-messages in ~/.emacs, and avoid infinite recursion in
 502 ;; bidi_initialize, which needs to load uni-mirrored.el and
 503 ;; uni-brackets.el in order to display the "Loading" messages.
 504 (unicode-property-table-internal 'mirroring)
 505 (unicode-property-table-internal 'bracket-type)
 506
 507 ;; Latin
 508
 509 (modify-category-entry '(#x80 . #x024F) ?l)
 510
 511 (let ((tbl (standard-case-table)) c)
 512
 513   ;; Latin-1
 514
 515   ;; Fixme: Some of the non-word syntaxes here perhaps should be
 516   ;; reviewed.  (Note that the following all implicitly have word
 517   ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.)  There should be a well-defined way of
 518   ;; relating Unicode categories to Emacs syntax codes.
 519
 520   ;; NBSP isn't semantically interchangeable with other whitespace chars,
 521   ;; so it's more like punctuation.
 522   (set-case-syntax ?  "." tbl)
 523   (set-case-syntax ?¡ "." tbl)
 524   (set-case-syntax ?¦ "_" tbl)
 525   (set-case-syntax ?§ "." tbl)
 526   (set-case-syntax ?© "_" tbl)
 527   ;; French wants
 528   ;;   (set-case-syntax-delims ?« ?» tbl)
 529   ;; And German wants
 530   ;;   (set-case-syntax-delims ?» ?« tbl)
 531   ;; So let's stay neutral and let users set these up if/when they want to.
 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   (set-case-syntax ?¿ "." tbl)
 545   (let ((c 192))
 546     (while (<= c 222)
 547       (set-case-syntax-pair c (+ c 32) tbl)
 548       (setq c (1+ c))))
 549   (set-case-syntax ?× "_" tbl)
 550   (set-case-syntax ?ß "w" tbl)
 551   (set-case-syntax ?÷ "_" tbl)
 552   ;; See below for ÿ.
 553
 554   ;; Latin Extended-A, Latin Extended-B
 555   (setq c #x0100)
 556   (while (<= c #x02B8)
 557     (modify-category-entry c ?l)
 558     (setq c (1+ c)))
 559
 560   (let ((pair-ranges '((#x0100 . #x012F)
 561                        (#x0132 . #x0137)
 562                        (#x0139 . #x0148)
 563                        (#x014a . #x0177)
 564                        (#x0179 . #x017E)
 565                        (#x0182 . #x0185)
 566                        (#x0187 . #x0188)
 567                        (#x018B . #x018C)
 568                        (#x0191 . #x0192)
 569                        (#x0198 . #x0199)
 570                        (#x01A0 . #x01A5)
 571                        (#x01A7 . #x01A8)
 572                        (#x01AC . #x01AD)
 573                        (#x01AF . #x01B0)
 574                        (#x01B3 . #x01B6)
 575                        (#x01B8 . #x01B9)
 576                        (#x01BC . #x01BD)
 577                        (#x01CD . #x01DC)
 578                        (#x01DE . #x01EF)
 579                        (#x01F4 . #x01F5)
 580                        (#x01F8 . #x021F)
 581                        (#x0222 . #x0233)
 582                        (#x023B . #x023C)
 583                        (#x0241 . #x0242)
 584                        (#x0246 . #x024F))))
 585     (dolist (elt pair-ranges)
 586       (let ((from (car elt)) (to (cdr elt)))
 587         (while (< from to)
 588           (set-case-syntax-pair from (1+ from) tbl)
 589           (setq from (+ from 2))))))
 590
 591   (set-case-syntax-pair ?Ÿ ?ÿ tbl)
 592
 593   ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
 594   ;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
 595   ;; do U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN
 596   ;; SMALL LETTER I.
 597
 598   ;; We used to set up half of those correspondence unconditionally,
 599   ;; but that makes searches slow.  So now we don't set up either half
 600   ;; of these correspondences by default.
 601
 602   ;; (set-downcase-syntax  ?İ ?i tbl)
 603   ;; (set-upcase-syntax    ?I ?ı tbl)
 604
 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 ?Ʒ ?ʒ tbl)
 625   (set-case-syntax-pair ?Ǆ ?ǆ tbl)
 626   (set-case-syntax-pair ?ǅ ?ǆ tbl)
 627   (set-case-syntax-pair ?Ǉ ?ǉ tbl)
 628   (set-case-syntax-pair ?ǈ ?ǉ tbl)
 629   (set-case-syntax-pair ?Ǌ ?ǌ tbl)
 630   (set-case-syntax-pair ?ǋ ?ǌ tbl)
 631
 632   ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
 633   (set-case-syntax-pair ?Ǳ ?ǳ tbl)
 634   (set-case-syntax-pair ?ǲ ?ǳ tbl)
 635   (set-case-syntax-pair ?Ƕ ?ƕ tbl)
 636   (set-case-syntax-pair ?Ƿ ?ƿ tbl)
 637   (set-case-syntax-pair ?Ⱥ ?ⱥ tbl)
 638   (set-case-syntax-pair ?Ƚ ?ƚ tbl)
 639   (set-case-syntax-pair ?Ⱦ ?ⱦ tbl)
 640   (set-case-syntax-pair ?Ƀ ?ƀ tbl)
 641   (set-case-syntax-pair ?Ʉ ?ʉ tbl)
 642   (set-case-syntax-pair ?Ʌ ?ʌ tbl)
 643
 644   ;; Latin Extended Additional
 645   (modify-category-entry '(#x1e00 . #x1ef9) ?l)
 646   (setq c #x1e00)
 647   (while (<= c #x1ef9)
 648     (and (zerop (% c 2))
 649          (or (<= c #x1e94) (>= c #x1ea0))
 650          (set-case-syntax-pair c (1+ c) tbl))
 651     (setq c (1+ c)))
 652
 653   ;; Latin Extended-C
 654   (setq c #x2C60)
 655   (while (<= c #x2C7F)
 656     (modify-category-entry c ?l)
 657     (setq c (1+ c)))
 658
 659   (let ((pair-ranges '((#x2C60 . #x2C61)
 660                        (#x2C67 . #x2C6C)
 661                        (#x2C72 . #x2C73)
 662                        (#x2C75 . #x2C76))))
 663     (dolist (elt pair-ranges)
 664       (let ((from (car elt)) (to (cdr elt)))
 665         (while (< from to)
 666           (set-case-syntax-pair from (1+ from) tbl)
 667           (setq from (+ from 2))))))
 668
 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   (set-case-syntax-pair ?Ɀ ?ɀ tbl)
 678
 679   ;; Latin Extended-D
 680   (setq c #xA720)
 681   (while (<= c #xA7FF)
 682     (modify-category-entry c ?l)
 683     (setq c (1+ c)))
 684
 685   (let ((pair-ranges '((#xA722 . #xA72F)
 686                        (#xA732 . #xA76F)
 687                        (#xA779 . #xA77C)
 688                        (#xA77E . #xA787)
 689                        (#xA78B . #xA78E)
 690                        (#xA790 . #xA793)
 691                        (#xA796 . #xA7A9)
 692                        (#xA7B4 . #xA7B7))))
 693     (dolist (elt pair-ranges)
 694       (let ((from (car elt)) (to (cdr elt)))
 695         (while (< from to)
 696           (set-case-syntax-pair from (1+ from) tbl)
 697           (setq from (+ from 2))))))
 698
 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   (set-case-syntax-pair ?Ʝ ?ʝ tbl)
 708   (set-case-syntax-pair ?Ꭓ ?ꭓ tbl)
 709
 710   ;; Latin Extended-E
 711   (setq c #xAB30)
 712   (while (<= c #xAB64)
 713     (modify-category-entry c ?l)
 714     (setq c (1+ c)))
 715
 716   ;; Greek
 717   (modify-category-entry '(#x0370 . #x03ff) ?g)
 718   (setq c #x0370)
 719   (while (<= c #x03ff)
 720     (if (or (and (>= c #x0391) (<= c #x03a1))
 721             (and (>= c #x03a3) (<= c #x03ab)))
 722         (set-case-syntax-pair c (+ c 32) tbl))
 723     (and (>= c #x03da)
 724          (<= c #x03ee)
 725          (zerop (% c 2))
 726          (set-case-syntax-pair c (1+ c) tbl))
 727     (setq c (1+ c)))
 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   (set-case-syntax-pair ?Ύ ?ύ tbl)
 734   (set-case-syntax-pair ?Ώ ?ώ tbl)
 735
 736   ;; Armenian
 737   (setq c #x531)
 738   (while (<= c #x556)
 739     (set-case-syntax-pair c (+ c #x30) tbl)
 740     (setq c (1+ c)))
 741
 742   ;; Greek Extended
 743   (modify-category-entry '(#x1f00 . #x1fff) ?g)
 744   (setq c #x1f00)
 745   (while (<= c #x1fff)
 746     (and (<= (logand c #x000f) 7)
 747          (<= c #x1fa7)
 748          (not (memq c '(#x1f16 #x1f17 #x1f56 #x1f57
 749                                #x1f50 #x1f52 #x1f54 #x1f56)))
 750          (/= (logand c #x00f0) #x70)
 751          (set-case-syntax-pair (+ c 8) c tbl))
 752     (setq c (1+ c)))
 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   (set-case-syntax-pair ?Ώ ?ώ tbl)
 776   (set-case-syntax-pair ?ῼ ?ῳ tbl)
 777
 778   ;; cyrillic
 779   (modify-category-entry '(#x0400 . #x04FF) ?y)
 780   (setq c #x0400)
 781   (while (<= c #x04ff)
 782     (and (>= c #x0400)
 783          (<= c #x040f)
 784          (set-case-syntax-pair c (+ c 80) tbl))
 785     (and (>= c #x0410)
 786          (<= c #x042f)
 787          (set-case-syntax-pair c (+ c 32) tbl))
 788     (and (zerop (% c 2))
 789          (or (and (>= c #x0460) (<= c #x0480))
 790              (and (>= c #x048c) (<= c #x04be))
 791              (and (>= c #x04d0) (<= c #x052e)))
 792          (set-case-syntax-pair c (1+ c) tbl))
 793     (setq c (1+ c)))
 794   (set-case-syntax-pair ?Ӂ ?ӂ tbl)
 795   (set-case-syntax-pair ?Ӄ ?ӄ tbl)
 796   (set-case-syntax-pair ?Ӈ ?ӈ tbl)
 797   (set-case-syntax-pair ?Ӌ ?ӌ tbl)
 798
 799   (modify-category-entry '(#xA640 . #xA69F) ?y)
 800   (setq c #xA640)
 801   (while (<= c #xA66C)
 802     (set-case-syntax-pair c (+ c 1) tbl)
 803     (setq c (+ c 2)))
 804   (setq c #xA680)
 805   (while (<= c #xA69A)
 806     (set-case-syntax-pair c (+ c 1) tbl)
 807     (setq c (+ c 2)))
 808
 809   ;; Georgian
 810   (setq c #x10A0)
 811   (while (<= c #x10CD)
 812     (set-case-syntax-pair c (+ c #x1C60) tbl)
 813     (setq c (1+ c)))
 814
 815   ;; Cyrillic Extended-C
 816   (modify-category-entry '(#x1C80 . #x1C8F) ?y)
 817
 818   ;; general punctuation
 819   (setq c #x2000)
 820   (while (<= c #x200b)
 821     (set-case-syntax c " " tbl)
 822     (setq c (1+ c)))
 823   (while (<= c #x200F)
 824     (set-case-syntax c "." tbl)
 825     (setq c (1+ c)))
 826   ;; Fixme: These aren't all right:
 827   (setq c #x2010)
 828   (while (<= c #x2016)
 829     (set-case-syntax c "_" tbl)
 830     (setq c (1+ c)))
 831   ;; Punctuation syntax for quotation marks (like `)
 832   (while (<= c #x201f)
 833     (set-case-syntax  c "." tbl)
 834     (setq c (1+ c)))
 835   ;; Fixme: These aren't all right:
 836   (while (<= c #x2027)
 837     (set-case-syntax c "_" tbl)
 838     (setq c (1+ c)))
 839   (while (<= c #x206F)
 840     (set-case-syntax c "." tbl)
 841     (setq c (1+ c)))
 842
 843   ;; Roman numerals
 844   (setq c #x2160)
 845   (while (<= c #x216f)
 846     (set-case-syntax-pair c (+ c #x10) tbl)
 847     (setq c (1+ c)))
 848
 849   ;; Fixme: The following blocks might be better as symbol rather than
 850   ;; punctuation.
 851   ;; Arrows
 852   (setq c #x2190)
 853   (while (<= c #x21FF)
 854     (set-case-syntax c "." tbl)
 855     (setq c (1+ c)))
 856   ;; Mathematical Operators
 857   (while (<= c #x22FF)
 858     (set-case-syntax c "." tbl)
 859     (setq c (1+ c)))
 860   ;; Miscellaneous Technical
 861   (while (<= c #x23FF)
 862     (set-case-syntax c "." tbl)
 863     (setq c (1+ c)))
 864   ;; Control Pictures
 865   (while (<= c #x243F)
 866     (set-case-syntax c "_" tbl)
 867     (setq c (1+ c)))
 868
 869   ;; Circled Latin
 870   (setq c #x24b6)
 871   (while (<= c #x24cf)
 872     (set-case-syntax-pair c (+ c 26) tbl)
 873     (modify-category-entry c ?l)
 874     (modify-category-entry (+ c 26) ?l)
 875     (setq c (1+ c)))
 876
 877   ;; Glagolitic
 878   (setq c #x2C00)
 879   (while (<= c #x2C2E)
 880     (set-case-syntax-pair c (+ c 48) tbl)
 881     (setq c (1+ c)))
 882
 883   ;; Coptic
 884   (let ((pair-ranges '((#x2C80 . #x2CE2)
 885                        (#x2CEB . #x2CF2))))
 886     (dolist (elt pair-ranges)
 887       (let ((from (car elt)) (to (cdr elt)))
 888         (while (< from to)
 889           (set-case-syntax-pair from (1+ from) tbl)
 890           (setq from (+ from 2))))))
 891   ;; There's no Coptic category.  However, Coptic letters that are
 892   ;; part of the Greek block above get the Greek category, and those
 893   ;; in this block are derived from Greek letters, so let's be
 894   ;; consistent about their category.
 895   (modify-category-entry '(#x2C80 . #x2CFF) ?g)
 896
 897   ;; Fullwidth Latin
 898   (setq c #xff21)
 899   (while (<= c #xff3a)
 900     (set-case-syntax-pair c (+ c #x20) tbl)
 901     (modify-category-entry c ?l)
 902     (modify-category-entry (+ c #x20) ?l)
 903     (setq c (1+ c)))
 904
 905   ;; Deseret
 906   (setq c #x10400)
 907   (while (<= c #x10427)
 908     (set-case-syntax-pair c (+ c 28) tbl)
 909     (setq c (1+ c)))
 910
 911   ;; Osage
 912   (setq c #x104B0)
 913   (while (<= c #x104D3)
 914     (set-case-syntax-pair c (+ c 40) tbl)
 915     (setq c (1+ c)))
 916
 917   ;; Old Hungarian
 918   (setq c #x10c80)
 919   (while (<= c #x10cb2)
 920     (set-case-syntax-pair c (+ c #x40) tbl)
 921     (setq c (1+ c)))
 922
 923   ;; Warang Citi
 924   (setq c #x118a0)
 925   (while (<= c #x118bf)
 926     (set-case-syntax-pair c (+ c #x20) tbl)
 927     (setq c (1+ c)))
 928
 929   ;; Adlam
 930   (setq c #x1e900)
 931   (while (<= c #x1e921)
 932     (set-case-syntax-pair c (+ c #x22) tbl)
 933     (setq c (1+ c)))
 934
 935   ;; Combining diacritics
 936   (modify-category-entry '(#x300 . #x362) ?^)
 937   ;; Combining marks
 938   (modify-category-entry '(#x20d0 . #x20ff) ?^)
 939
 940   ;; Fixme: syntax for symbols &c
 941   )
 942
 943 (let ((pairs
 944        '("⁅⁆"                               ; U+2045 U+2046
 945          "⁽⁾"                               ; U+207D U+207E
 946          "₍₎"                               ; U+208D U+208E
 947          "〈〉"                               ; U+2329 U+232A
 948          "⎴⎵"                               ; U+23B4 U+23B5
 949          "❨❩"                               ; U+2768 U+2769
 950          "❪❫"                               ; U+276A U+276B
 951          "❬❭"                               ; U+276C U+276D
 952          "❰❱"                               ; U+2770 U+2771
 953          "❲❳"                               ; U+2772 U+2773
 954          "❴❵"                               ; U+2774 U+2775
 955          "⟦⟧"                               ; U+27E6 U+27E7
 956          "⟨⟩"                               ; U+27E8 U+27E9
 957          "⟪⟫"                               ; U+27EA U+27EB
 958          "⦃⦄"                               ; U+2983 U+2984
 959          "⦅⦆"                               ; U+2985 U+2986
 960          "⦇⦈"                               ; U+2987 U+2988
 961          "⦉⦊"                               ; U+2989 U+298A
 962          "⦋⦌"                               ; U+298B U+298C
 963          "⦍⦎"                               ; U+298D U+298E
 964          "⦏⦐"                               ; U+298F U+2990
 965          "⦑⦒"                               ; U+2991 U+2992
 966          "⦓⦔"                               ; U+2993 U+2994
 967          "⦕⦖"                               ; U+2995 U+2996
 968          "⦗⦘"                               ; U+2997 U+2998
 969          "⧼⧽"                               ; U+29FC U+29FD
 970          "〈〉"                               ; U+3008 U+3009
 971          "《》"                               ; U+300A U+300B
 972          "「」"                               ; U+300C U+300D
 973          "『』"                               ; U+300E U+300F
 974          "【】"                               ; U+3010 U+3011
 975          "〔〕"                               ; U+3014 U+3015
 976          "〖〗"                               ; U+3016 U+3017
 977          "〘〙"                               ; U+3018 U+3019
 978          "〚〛"                               ; U+301A U+301B
 979          "﴾﴿"                               ; U+FD3E U+FD3F
 980          "︵︶"                               ; U+FE35 U+FE36
 981          "︷︸"                               ; U+FE37 U+FE38
 982          "︹︺"                               ; U+FE39 U+FE3A
 983          "︻︼"                               ; U+FE3B U+FE3C
 984          "︽︾"                               ; U+FE3D U+FE3E
 985          "︿﹀"                               ; U+FE3F U+FE40
 986          "﹁﹂"                               ; U+FE41 U+FE42
 987          "﹃﹄"                               ; U+FE43 U+FE44
 988          "﹙﹚"                               ; U+FE59 U+FE5A
 989          "﹛﹜"                               ; U+FE5B U+FE5C
 990          "﹝﹞"                               ; U+FE5D U+FE5E
 991          "（）"                               ; U+FF08 U+FF09
 992          "［］"                               ; U+FF3B U+FF3D
 993          "｛｝"                               ; U+FF5B U+FF5D
 994          "｟｠"                               ; U+FF5F U+FF60
 995          "｢｣"                               ; U+FF62 U+FF63
 996          )))
 997   (dolist (elt pairs)
 998     (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
 999     (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
1000
1001 \f
1002 ;; For each character set, put the information of the most proper
1003 ;; coding system to encode it by `preferred-coding-system' property.
1004
1005 ;; Fixme: should this be junked?
1006 (let ((l '((latin-iso8859-1     . iso-latin-1)
1007            (latin-iso8859-2     . iso-latin-2)
1008            (latin-iso8859-3     . iso-latin-3)
1009            (latin-iso8859-4     . iso-latin-4)
1010            (thai-tis620         . thai-tis620)
1011            (greek-iso8859-7     . greek-iso-8bit)
1012            (arabic-iso8859-6    . iso-2022-7bit)
1013            (hebrew-iso8859-8    . hebrew-iso-8bit)
1014            (katakana-jisx0201   . japanese-shift-jis)
1015            (latin-jisx0201      . japanese-shift-jis)
1016            (cyrillic-iso8859-5  . cyrillic-iso-8bit)
1017            (latin-iso8859-9     . iso-latin-5)
1018            (japanese-jisx0208-1978 . iso-2022-jp)
1019            (chinese-gb2312      . chinese-iso-8bit)
1020            (chinese-gbk         . chinese-gbk)
1021            (gb18030-2-byte      . chinese-gb18030)
1022            (gb18030-4-byte-bmp  . chinese-gb18030)
1023            (gb18030-4-byte-smp  . chinese-gb18030)
1024            (gb18030-4-byte-ext-1 . chinese-gb18030)
1025            (gb18030-4-byte-ext-2 . chinese-gb18030)
1026            (japanese-jisx0208   . iso-2022-jp)
1027            (korean-ksc5601      . iso-2022-kr)
1028            (japanese-jisx0212   . iso-2022-jp)
1029            (chinese-big5-1      . chinese-big5)
1030            (chinese-big5-2      . chinese-big5)
1031            (chinese-sisheng     . iso-2022-7bit)
1032            (ipa                 . iso-2022-7bit)
1033            (vietnamese-viscii-lower . vietnamese-viscii)
1034            (vietnamese-viscii-upper . vietnamese-viscii)
1035            (arabic-digit        . iso-2022-7bit)
1036            (arabic-1-column     . iso-2022-7bit)
1037            (lao                 . lao)
1038            (arabic-2-column     . iso-2022-7bit)
1039            (indian-is13194      . devanagari)
1040            (indian-glyph        . devanagari)
1041            (tibetan-1-column    . tibetan)
1042            (ethiopic            . iso-2022-7bit)
1043            (chinese-cns11643-1  . iso-2022-cn)
1044            (chinese-cns11643-2  . iso-2022-cn)
1045            (chinese-cns11643-3  . iso-2022-cn)
1046            (chinese-cns11643-4  . iso-2022-cn)
1047            (chinese-cns11643-5  . iso-2022-cn)
1048            (chinese-cns11643-6  . iso-2022-cn)
1049            (chinese-cns11643-7  . iso-2022-cn)
1050            (indian-2-column     . devanagari)
1051            (tibetan             . tibetan)
1052            (latin-iso8859-14    . iso-latin-8)
1053            (latin-iso8859-15    . iso-latin-9))))
1054   (while l
1055     (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
1056     (setq l (cdr l))))
1057
1058 \f
1059 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
1060 ;; SPACE and NEWLINE are already set.
1061
1062 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
1063 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
1064 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
1065 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
1066 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
1067 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
1068
1069 \f
1070 ;;; Setting char-width-table.  The default is 1.
1071
1072 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
1073 ;;    and final characters.
1074 (let ((l '((#x0300 . #x036F)
1075            (#x0483 . #x0489)
1076            (#x0591 . #x05BD)
1077            (#x05BF . #x05BF)
1078            (#x05C1 . #x05C2)
1079            (#x05C4 . #x05C5)
1080            (#x05C7 . #x05C7)
1081            (#x0600 . #x0603)
1082            (#x0610 . #x0615)
1083            (#x064B . #x065E)
1084            (#x0670 . #x0670)
1085            (#x06D6 . #x06E4)
1086            (#x06E7 . #x06E8)
1087            (#x06EA . #x06ED)
1088            (#x070F . #x070F)
1089            (#x0711 . #x0711)
1090            (#x0730 . #x074A)
1091            (#x07A6 . #x07B0)
1092            (#x07EB . #x07F3)
1093            (#x0901 . #x0902)
1094            (#x093C . #x093C)
1095            (#x0941 . #x0948)
1096            (#x094D . #x094D)
1097            (#x0951 . #x0954)
1098            (#x0962 . #x0963)
1099            (#x0981 . #x0981)
1100            (#x09BC . #x09BC)
1101            (#x09C1 . #x09C4)
1102            (#x09CD . #x09CD)
1103            (#x09E2 . #x09E3)
1104            (#x0A01 . #x0A02)
1105            (#x0A3C . #x0A3C)
1106            (#x0A41 . #x0A4D)
1107            (#x0A70 . #x0A71)
1108            (#x0A81 . #x0A82)
1109            (#x0ABC . #x0ABC)
1110            (#x0AC1 . #x0AC8)
1111            (#x0ACD . #x0ACD)
1112            (#x0AE2 . #x0AE3)
1113            (#x0B01 . #x0B01)
1114            (#x0B3C . #x0B3C)
1115            (#x0B3F . #x0B3F)
1116            (#x0B41 . #x0B43)
1117            (#x0B4D . #x0B56)
1118            (#x0B82 . #x0B82)
1119            (#x0BC0 . #x0BC0)
1120            (#x0BCD . #x0BCD)
1121            (#x0C3E . #x0C40)
1122            (#x0C46 . #x0C56)
1123            (#x0CBC . #x0CBC)
1124            (#x0CBF . #x0CBF)
1125            (#x0CC6 . #x0CC6)
1126            (#x0CCC . #x0CCD)
1127            (#x0CE2 . #x0CE3)
1128            (#x0D41 . #x0D43)
1129            (#x0D4D . #x0D4D)
1130            (#x0DCA . #x0DCA)
1131            (#x0DD2 . #x0DD6)
1132            (#x0E31 . #x0E31)
1133            (#x0E34 . #x0E3A)
1134            (#x0E47 . #x0E4E)
1135            (#x0EB1 . #x0EB1)
1136            (#x0EB4 . #x0EBC)
1137            (#x0EC8 . #x0ECD)
1138            (#x0F18 . #x0F19)
1139            (#x0F35 . #x0F35)
1140            (#x0F37 . #x0F37)
1141            (#x0F39 . #x0F39)
1142            (#x0F71 . #x0F7E)
1143            (#x0F80 . #x0F84)
1144            (#x0F86 . #x0F87)
1145            (#x0F90 . #x0FBC)
1146            (#x0FC6 . #x0FC6)
1147            (#x102D . #x1030)
1148            (#x1032 . #x1037)
1149            (#x1039 . #x1039)
1150            (#x1058 . #x1059)
1151            (#x1160 . #x11FF)
1152            (#x135F . #x135F)
1153            (#x1712 . #x1714)
1154            (#x1732 . #x1734)
1155            (#x1752 . #x1753)
1156            (#x1772 . #x1773)
1157            (#x17B4 . #x17B5)
1158            (#x17B7 . #x17BD)
1159            (#x17C6 . #x17C6)
1160            (#x17C9 . #x17D3)
1161            (#x17DD . #x17DD)
1162            (#x180B . #x180D)
1163            (#x18A9 . #x18A9)
1164            (#x1920 . #x1922)
1165            (#x1927 . #x1928)
1166            (#x1932 . #x1932)
1167            (#x1939 . #x193B)
1168            (#x1A17 . #x1A18)
1169            (#x1B00 . #x1B03)
1170            (#x1B34 . #x1B34)
1171            (#x1B36 . #x1B3A)
1172            (#x1B3C . #x1B3C)
1173            (#x1B42 . #x1B42)
1174            (#x1B6B . #x1B73)
1175            (#x1DC0 . #x1DFF)
1176            (#x200B . #x200F)
1177            (#x202A . #x202E)
1178            (#x2060 . #x206F)
1179            (#x20D0 . #x20EF)
1180            (#x302A . #x302F)
1181            (#x3099 . #x309A)
1182            (#xA806 . #xA806)
1183            (#xA80B . #xA80B)
1184            (#xA825 . #xA826)
1185            (#xFB1E . #xFB1E)
1186            (#xFE00 . #xFE0F)
1187            (#xFE20 . #xFE23)
1188            (#xFEFF . #xFEFF)
1189            (#xFFF9 . #xFFFB)
1190            (#x10A01 . #x10A0F)
1191            (#x10A38 . #x10A3F)
1192            (#x1D167 . #x1D169)
1193            (#x1D173 . #x1D182)
1194            (#x1D185 . #x1D18B)
1195            (#x1D1AA . #x1D1AD)
1196            (#x1D242 . #x1D244)
1197            (#xE0001 . #xE01EF))))
1198   (dolist (elt l)
1199     (set-char-table-range char-width-table elt 0)))
1200
1201 ;; 2: East Asian Wide and Full-width characters.
1202 (let ((l '((#x1100 . #x115F)
1203            (#x231A . #x231B)
1204            (#x2329 . #x232A)
1205            (#x23E9 . #x23EC)
1206            (#x23F0 . #x23F0)
1207            (#x23F3 . #x23F3)
1208            (#x25FD . #x25FE)
1209            (#x2614 . #x2615)
1210            (#x2648 . #x2653)
1211            (#x267F . #x267F)
1212            (#x2693 . #x2693)
1213            (#x26A1 . #x26A1)
1214            (#x26AA . #x26AB)
1215            (#x26BD . #x26BE)
1216            (#x26C4 . #x26C5)
1217            (#x26CE . #x26CE)
1218            (#x26D4 . #x26D4)
1219            (#x26EA . #x26EA)
1220            (#x26F2 . #x26F3)
1221            (#x26F5 . #x26F5)
1222            (#x26FA . #x26FA)
1223            (#x26FD . #x26FD)
1224            (#x2705 . #x2705)
1225            (#x270A . #x270B)
1226            (#x2728 . #x2728)
1227            (#x274C . #x274C)
1228            (#x274E . #x274E)
1229            (#x2753 . #x2755)
1230            (#x2757 . #x2757)
1231            (#x2795 . #x2797)
1232            (#x27B0 . #x27B0)
1233            (#x27BF . #x27BF)
1234            (#x2B1B . #x2B1C)
1235            (#x2B50 . #x2B50)
1236            (#x2B55 . #x2B55)
1237            (#x2E80 . #x303E)
1238            (#x3040 . #xA4CF)
1239            (#xAC00 . #xD7A3)
1240            (#xF900 . #xFAFF)
1241            (#xFE30 . #xFE6F)
1242            (#xFF01 . #xFF60)
1243            (#xFFE0 . #xFFE6)
1244            (#x16FE0 . #x16FE0)
1245            (#x17000 . #x187EC)
1246            (#x18800 . #x18AF2)
1247            (#x1F18E . #x1F18E)
1248            (#x1F191 . #x1F19A)
1249            (#x1F200 . #x1F202)
1250            (#x1F210 . #x1F23B)
1251            (#x1F300 . #x1F320)
1252            (#x1F32D . #x1F335)
1253            (#x1F337 . #x1F37C)
1254            (#x1F37E . #x1F393)
1255            (#x1F3A0 . #x1F3CA)
1256            (#x1F3CF . #x1F3D3)
1257            (#x1F3E0 . #x1F3F0)
1258            (#x1F3F4 . #x1F3F4)
1259            (#x1F3F8 . #x1F3FA)
1260            (#x1F3FB . #x1F43E)
1261            (#x1F440 . #x1F440)
1262            (#x1F442 . #x1F4FC)
1263            (#x1F4FF . #x1F53D)
1264            (#x1F54B . #x1F54E)
1265            (#x1F550 . #x1F567)
1266            (#x1F57A . #x1F57A)
1267            (#x1F595 . #x1F596)
1268            (#x1F5A4 . #x1F5A4)
1269            (#x1F5FB . #x1F5FF)
1270            (#x1F600 . #x1F64F)
1271            (#x1F680 . #x1F6C5)
1272            (#x1F6CC . #x1F6CC)
1273            (#x1F6D0 . #x1F6D2)
1274            (#x1F6EB . #x1F6EC)
1275            (#x1F6F4 . #x1F6F6)
1276            (#x1F910 . #x1F91E)
1277            (#x1F920 . #x1F927)
1278            (#x1F930 . #x1F930)
1279            (#x1F933 . #x1F93E)
1280            (#x1F940 . #x1F94B)
1281            (#x1F950 . #x1F95E)
1282            (#x1F980 . #x1F991)
1283            (#x1F9C0 . #x1F9C0)
1284            (#x20000 . #x2FFFF)
1285            (#x30000 . #x3FFFF))))
1286   (dolist (elt l)
1287     (set-char-table-range char-width-table elt 2)))
1288
1289 ;; Other double width
1290 ;;(map-charset-chars
1291 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1292 ;; 'ethiopic)
1293 ;; (map-charset-chars
1294 ;;  (lambda (range ignore) (set-char-table-range char-width-table range 2))
1295 ;; 'tibetan)
1296 (map-charset-chars
1297  (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1298  'indian-2-column)
1299 (map-charset-chars
1300  (lambda (range _ignore) (set-char-table-range char-width-table range 2))
1301  'arabic-2-column)
1302
1303 ;; Internal use only.
1304 ;; Alist of locale symbol vs charsets.  In a language environment
1305 ;; corresponding to the locale, width of characters in the charsets is
1306 ;; set to 2.  Each element has the form:
1307 ;;   (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1308 ;; LOCALE: locale symbol
1309 ;; TABLE: char-table used for char-width-table, initially nil.
1310 ;; CHARSET: character set
1311 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1312
1313 (defvar cjk-char-width-table-list
1314   '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1315                (cp932-2-byte (#x8140 . #x879F)))
1316     (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1317     (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1318     (zh_TW nil (big5 (#xA140 . #xA3FE))
1319                (chinese-cns11643-1 (#x2121 . #x427E)))
1320     (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1321
1322 ;; Internal use only.
1323 ;; Setup char-width-table appropriate for a language environment
1324 ;; corresponding to LOCALE-NAME (symbol).
1325
1326 (defun use-cjk-char-width-table (locale-name)
1327   (while (char-table-parent char-width-table)
1328     (setq char-width-table (char-table-parent char-width-table)))
1329   (let ((slot (assq locale-name cjk-char-width-table-list)))
1330     (or slot (error "Unknown locale for CJK language environment: %s"
1331                     locale-name))
1332     (unless (nth 1 slot)
1333       (let ((table (make-char-table nil)))
1334         (dolist (charset-info (nthcdr 2 slot))
1335           (let ((charset (car charset-info)))
1336             (dolist (code-range (cdr charset-info))
1337               (map-charset-chars #'(lambda (range _arg)
1338                                      (set-char-table-range table range 2))
1339                                  charset nil
1340                                  (car code-range) (cdr code-range)))))
1341         (optimize-char-table table)
1342         (set-char-table-parent table char-width-table)
1343         (setcar (cdr slot) table)))
1344     (setq char-width-table (nth 1 slot))))
1345
1346 (defun use-default-char-width-table ()
1347   "Internal use only.
1348 Setup char-width-table appropriate for non-CJK language environment."
1349   (while (char-table-parent char-width-table)
1350     (setq char-width-table (char-table-parent char-width-table))))
1351
1352 (optimize-char-table (standard-case-table))
1353 (optimize-char-table (standard-syntax-table))
1354
1355 \f
1356 ;; Setting char-script-table.
1357 (if purify-flag
1358     ;; While dumping, we can't use require, and international is not
1359     ;; in load-path.
1360     (load "international/charscript")
1361   (require 'charscript))
1362
1363 (map-charset-chars
1364  #'(lambda (range _ignore)
1365      (set-char-table-range char-script-table range 'tibetan))
1366  'tibetan)
1367
1368 \f
1369 ;;; Setting unicode-category-table.
1370
1371 (when (setq unicode-category-table
1372             (unicode-property-table-internal 'general-category))
1373   (map-char-table #'(lambda (key val)
1374                       (if val
1375                           (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
1376                                           (/= (aref (symbol-name val) 0) ?C))
1377                                      (eq val 'Zs))
1378                                  (modify-category-entry key ?.))
1379                                 ((eq val 'Mn)
1380                                  (modify-category-entry key ?^)))))
1381                   unicode-category-table))
1382
1383 (optimize-char-table (standard-category-table))
1384
1385 \f
1386 ;; Display of glyphless characters.
1387
1388 (defvar char-acronym-table
1389   (make-char-table 'char-acronym-table nil)
1390   "Char table of acronyms for non-graphic characters.")
1391
1392 (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
1393                      "BS"   nil   nil  "VT"  "FF"  "CR"  "SO"  "SI"
1394                      "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
1395                      "CAN" "EM"  "SUB" "ESC" "FC"  "GS"  "RS"  "US")))
1396   (dotimes (i 32)
1397     (aset char-acronym-table i (car c0-acronyms))
1398     (setq c0-acronyms (cdr c0-acronyms))))
1399
1400 (let ((c1-acronyms '("XXX" "XXX" "BPH" "NBH" "IND" "NEL" "SSA" "ESA"
1401                      "HTS" "HTJ" "VTS" "PLD" "PLU" "R1"  "SS2" "SS1"
1402                      "DCS" "PU1" "PU2" "STS" "CCH" "MW"  "SPA" "EPA"
1403                      "SOS" "XXX" "SC1" "CSI" "ST"  "OSC" "PM"  "APC")))
1404   (dotimes (i 32)
1405     (aset char-acronym-table (+ #x0080 i) (car c1-acronyms))
1406     (setq c1-acronyms (cdr c1-acronyms))))
1407
1408 (aset char-acronym-table #x17B4 "KIVAQ")   ; KHMER VOWEL INHERENT AQ
1409 (aset char-acronym-table #x17B5 "KIVAA")   ; KHMER VOWEL INHERENT AA
1410 (aset char-acronym-table #x200B "ZWSP")    ; ZERO WIDTH SPACE
1411 (aset char-acronym-table #x200C "ZWNJ")    ; ZERO WIDTH NON-JOINER
1412 (aset char-acronym-table #x200D "ZWJ")     ; ZERO WIDTH JOINER
1413 (aset char-acronym-table #x200E "LRM")     ; LEFT-TO-RIGHT MARK
1414 (aset char-acronym-table #x200F "RLM")     ; RIGHT-TO-LEFT MARK
1415 (aset char-acronym-table #x202A "LRE")     ; LEFT-TO-RIGHT EMBEDDING
1416 (aset char-acronym-table #x202B "RLE")     ; RIGHT-TO-LEFT EMBEDDING
1417 (aset char-acronym-table #x202C "PDF")     ; POP DIRECTIONAL FORMATTING
1418 (aset char-acronym-table #x202D "LRO")     ; LEFT-TO-RIGHT OVERRIDE
1419 (aset char-acronym-table #x202E "RLO")     ; RIGHT-TO-LEFT OVERRIDE
1420 (aset char-acronym-table #x2060 "WJ")      ; WORD JOINER
1421 (aset char-acronym-table #x206A "ISS")     ; INHIBIT SYMMETRIC SWAPPING
1422 (aset char-acronym-table #x206B "ASS")     ; ACTIVATE SYMMETRIC SWAPPING
1423 (aset char-acronym-table #x206C "IAFS")    ; INHIBIT ARABIC FORM SHAPING
1424 (aset char-acronym-table #x206D "AAFS")    ; ACTIVATE ARABIC FORM SHAPING
1425 (aset char-acronym-table #x206E "NADS")    ; NATIONAL DIGIT SHAPES
1426 (aset char-acronym-table #x206F "NODS")    ; NOMINAL DIGIT SHAPES
1427 (aset char-acronym-table #xFEFF "ZWNBSP")  ; ZERO WIDTH NO-BREAK SPACE
1428 (aset char-acronym-table #xFFF9 "IAA")     ; INTERLINEAR ANNOTATION ANCHOR
1429 (aset char-acronym-table #xFFFA "IAS")     ; INTERLINEAR ANNOTATION SEPARATOR
1430 (aset char-acronym-table #xFFFB "IAT")     ; INTERLINEAR ANNOTATION TERMINATOR
1431 (aset char-acronym-table #x1D173 "BEGBM")  ; MUSICAL SYMBOL BEGIN BEAM
1432 (aset char-acronym-table #x1D174 "ENDBM")  ; MUSICAL SYMBOL END BEAM
1433 (aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE
1434 (aset char-acronym-table #x1D176 "END")    ; MUSICAL SYMBOL END TIE
1435 (aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR
1436 (aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR
1437 (aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE
1438 (aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE
1439 (aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG
1440 (aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE
1441 (dotimes (i 94)
1442   (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
1443 (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
1444
1445 (defun update-glyphless-char-display (&optional variable value)
1446   "Make the setting of `glyphless-char-display-control' take effect.
1447 This function updates the char-table `glyphless-char-display'."
1448   (when value
1449     (set-default variable value))
1450   (dolist (elt value)
1451     (let ((target (car elt))
1452           (method (cdr elt)))
1453       (or (memq method '(zero-width thin-space empty-box acronym hex-code))
1454           (error "Invalid glyphless character display method: %s" method))
1455       (cond ((eq target 'c0-control)
1456              (glyphless-set-char-table-range glyphless-char-display
1457                                              #x00 #x1F method)
1458              ;; Users will not expect their newlines and TABs be
1459              ;; displayed as anything but themselves, so exempt those
1460              ;; two characters from c0-control.
1461              (set-char-table-range glyphless-char-display #x9 nil)
1462              (set-char-table-range glyphless-char-display #xa nil))
1463             ((eq target 'c1-control)
1464              (glyphless-set-char-table-range glyphless-char-display
1465                                              #x80 #x9F method))
1466             ((eq target 'format-control)
1467              (when unicode-category-table
1468                (map-char-table
1469                 #'(lambda (char category)
1470                     (if (eq category 'Cf)
1471                         (let ((this-method method)
1472                               from to)
1473                           (if (consp char)
1474                               (setq from (car char) to (cdr char))
1475                             (setq from char to char))
1476                           (while (<= from to)
1477                             (when (/= from #xAD)
1478                               (if (eq method 'acronym)
1479                                   (setq this-method
1480                                         (aref char-acronym-table from)))
1481                               (set-char-table-range glyphless-char-display
1482                                                     from this-method))
1483                             (setq from (1+ from))))))
1484                 unicode-category-table)))
1485             ((eq target 'no-font)
1486              (set-char-table-extra-slot glyphless-char-display 0 method))
1487             (t
1488              (error "Invalid glyphless character group: %s" target))))))
1489
1490 (defun glyphless-set-char-table-range (chartable from to method)
1491   (if (eq method 'acronym)
1492       (let ((i from))
1493         (while (<= i to)
1494           (set-char-table-range chartable i (aref char-acronym-table i))
1495           (setq i (1+ i))))
1496     (set-char-table-range chartable (cons from to) method)))
1497
1498 ;;; Control of displaying glyphless characters.
1499 (defcustom glyphless-char-display-control
1500   '((format-control . thin-space)
1501     (no-font . hex-code))
1502   "List of directives to control display of glyphless characters.
1503
1504 Each element has the form (GROUP . METHOD), where GROUP is a
1505 symbol specifying the character group, and METHOD is a symbol
1506 specifying the method of displaying characters belonging to that
1507 group.
1508
1509 GROUP must be one of these symbols:
1510   `c0-control':     U+0000..U+001F, but excluding newline and TAB.
1511   `c1-control':     U+0080..U+009F.
1512   `format-control': Characters of Unicode General Category `Cf',
1513                     such as U+200C (ZWNJ), U+200E (LRM), but
1514                     excluding characters that have graphic images,
1515                     such as U+00AD (SHY).
1516   `no-font':        characters for which no suitable font is found.
1517                     For character terminals, characters that cannot
1518                     be encoded by `terminal-coding-system'.
1519
1520 METHOD must be one of these symbols:
1521   `zero-width': don't display.
1522   `thin-space': display a thin (1-pixel width) space.  On character
1523                 terminals, display as 1-character space.
1524   `empty-box':  display an empty box.
1525   `acronym':    display an acronym of the character in a box.  The
1526                 acronym is taken from `char-acronym-table', which see.
1527   `hex-code':   display the hexadecimal character code in a box.
1528
1529 Do not set its value directly from Lisp; the value takes effect
1530 only via a custom `:set'
1531 function (`update-glyphless-char-display'), which updates
1532 `glyphless-char-display'."
1533   :version "24.1"
1534   :type '(alist :key-type (symbol :tag "Character Group")
1535                 :value-type (symbol :tag "Display Method"))
1536   :options '((c0-control
1537               (choice (const :tag "Don't display" zero-width)
1538                       (const :tag "Display as thin space" thin-space)
1539                       (const :tag "Display as empty box" empty-box)
1540                       (const :tag "Display acronym" acronym)
1541                       (const :tag "Display hex code in a box" hex-code)))
1542              (c1-control
1543               (choice (const :tag "Don't display" zero-width)
1544                       (const :tag "Display as thin space" thin-space)
1545                       (const :tag "Display as empty box" empty-box)
1546                       (const :tag "Display acronym" acronym)
1547                       (const :tag "Display hex code in a box" hex-code)))
1548              (format-control
1549               (choice (const :tag "Don't display" zero-width)
1550                       (const :tag "Display as thin space" thin-space)
1551                       (const :tag "Display as empty box" empty-box)
1552                       (const :tag "Display acronym" acronym)
1553                       (const :tag "Display hex code in a box" hex-code)))
1554              (no-font
1555               (choice (const :tag "Don't display" zero-width)
1556                       (const :tag "Display as thin space" thin-space)
1557                       (const :tag "Display as empty box" empty-box)
1558                       (const :tag "Display acronym" acronym)
1559                       (const :tag "Display hex code in a box" hex-code))))
1560   :set 'update-glyphless-char-display
1561   :group 'display)
1562
1563 \f
1564 ;;; Setting word boundary.
1565
1566 (setq word-combining-categories
1567       '((nil . ?^)
1568         (?^ . nil)
1569         (?C . ?H)
1570         (?C . ?K)))
1571
1572 (setq word-separating-categories        ;  (2-byte character sets)
1573       '((?H . ?K)                       ; Hiragana - Katakana
1574         ))
1575
1576 ;; Local Variables:
1577 ;; coding: utf-8
1578 ;; End:
1579
1580 ;;; characters.el ends here