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