lisp/international/characters.el

   1 ;;; characters.el --- set syntax and category for multibyte characters
   2
   3 ;; Copyright (C) 1997, 2000-2011  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 (car chars) "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 (modify-category-entry ?ー ?K)
 238 (let ((chars '(?゛ ?゜)))
 239   (while chars
 240     (modify-category-entry (car chars) ?K)
 241     (modify-category-entry (car chars) ?H)
 242     (setq chars (cdr chars))))
 243 (let ((chars '(?仝 ?々 ?〆 ?〇)))
 244   (while chars
 245     (modify-category-entry (car chars) ?C)
 246     (setq chars (cdr chars))))
 247
 248 ;; JISX0212
 249
 250 (map-charset-chars #'modify-syntax-entry 'japanese-jisx0212 "_" #x2121 #x237E)
 251
 252 ;; JISX0201-Kana
 253
 254 (let ((chars '(?｡ ?､ ?･)))
 255   (while chars
 256     (modify-syntax-entry (car chars) ".")
 257     (setq chars (cdr chars))))
 258
 259 (modify-syntax-entry ?\｢ "(｣")
 260 (modify-syntax-entry ?\｣ "(｢")
 261
 262 ;; Korean character set (KSC5601)
 263
 264 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?h)
 265
 266 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
 267 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
 268 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
 269 (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
 270 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
 271 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
 272 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
 273 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?G #x2521 #x257E)
 274 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?H #x2A21 #x2A7E)
 275 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?K #x2B21 #x2B7E)
 276 (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?Y #x2C21 #x2C7E)
 277
 278 ;; These are in more than one charset.
 279 (let ((parens (concat "〈〉《》「」『』【】〔〕〖〗〘〙〚〛"
 280                       "︵︶︷︸︹︺︻︼︽︾︿﹀﹁﹂﹃﹄"
 281                       "（）［］｛｝"))
 282       open close)
 283   (dotimes (i (/ (length parens) 2))
 284     (setq open (aref parens (* i 2))
 285           close (aref parens (1+ (* i 2))))
 286     (modify-syntax-entry open (format "(%c" close))
 287     (modify-syntax-entry close (format ")%c" open))))
 288
 289 ;; Arabic character set
 290
 291 (let ((charsets '(arabic-iso8859-6
 292                   arabic-digit
 293                   arabic-1-column
 294                   arabic-2-column)))
 295   (while charsets
 296     (map-charset-chars #'modify-category-entry (car charsets) ?b)
 297     (setq charsets (cdr charsets))))
 298 (modify-category-entry '(#x600 . #x6ff) ?b)
 299 (modify-category-entry '(#xfb50 . #xfdff) ?b)
 300 (modify-category-entry '(#xfe70 . #xfefe) ?b)
 301
 302 ;; Cyrillic character set (ISO-8859-5)
 303
 304 (modify-syntax-entry ?№ ".")
 305
 306 ;; Ethiopic character set
 307
 308 (modify-category-entry '(#x1200 . #x1399) ?e)
 309 (modify-category-entry '(#x2d80 . #x2dde) ?e)
 310 (let ((chars '(?፡ ?። ?፣ ?፤ ?፥ ?፦ ?፧ ?፨)))
 311   (while chars
 312     (modify-syntax-entry (car chars) ".")
 313     (setq chars (cdr chars))))
 314 (map-charset-chars #'modify-category-entry 'ethiopic ?e)
 315
 316 ;; Hebrew character set (ISO-8859-8)
 317
 318 (modify-syntax-entry #x5be ".") ; MAQAF
 319 (modify-syntax-entry #x5c0 ".") ; PASEQ
 320 (modify-syntax-entry #x5c3 ".") ; SOF PASUQ
 321 (modify-syntax-entry #x5f3 ".") ; GERESH
 322 (modify-syntax-entry #x5f4 ".") ; GERSHAYIM
 323
 324 ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
 325
 326 (modify-category-entry '(#x901 . #x970) ?i)
 327 (map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
 328 (map-charset-chars #'modify-category-entry 'indian-2-column ?i)
 329
 330 ;; Lao character set
 331
 332 (modify-category-entry '(#xe80 . #xeff) ?o)
 333 (map-charset-chars #'modify-category-entry 'lao ?o)
 334
 335 (let ((deflist  '(("ກ-ຮ"    "w"     ?0) ; consonant
 336                   ("ະາຳຽເ-ໄ"        "w"     ?1) ; vowel base
 337                   ("ັິ-ືົໍ"   "w"     ?2) ; vowel upper
 338                   ("ຸູ"     "w"     ?3) ; vowel lower
 339                   ("່-໋"    "w"     ?4) ; tone mark
 340                   ("ຼຽ"     "w"     ?9) ; semivowel lower
 341                   ("໐-໙"    "w"     ?6) ; digit
 342                   ("ຯໆ"     "_"     ?5) ; symbol
 343                   ))
 344       elm chars len syntax category to ch i)
 345   (while deflist
 346     (setq elm (car deflist))
 347     (setq chars (car elm)
 348           len (length chars)
 349           syntax (nth 1 elm)
 350           category (nth 2 elm)
 351           i 0)
 352     (while (< i len)
 353       (if (= (aref chars i) ?-)
 354           (setq i (1+ i)
 355                 to (aref chars i))
 356         (setq ch (aref chars i)
 357               to ch))
 358       (while (<= ch to)
 359         (unless (string-equal syntax "w")
 360           (modify-syntax-entry ch syntax))
 361         (modify-category-entry ch category)
 362         (setq ch (1+ ch)))
 363       (setq i (1+ i)))
 364     (setq deflist (cdr deflist))))
 365
 366 ;; Thai character set (TIS620)
 367
 368 (modify-category-entry '(#xe00 . #xe7f) ?t)
 369 (map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
 370
 371 (let ((deflist  '(;; chars      syntax  category
 372                   ("ก-รลว-ฮ"  "w"     ?0) ; consonant
 373                   ("ฤฦะาำเ-ๅ"     "w"     ?1) ; vowel base
 374                   ("ัิ-ื็๎"   "w"     ?2) ; vowel upper
 375                   ("ุ-ฺ"    "w"     ?3) ; vowel lower
 376                   ("่-ํ"    "w"     ?4) ; tone mark
 377                   ("๐-๙"    "w"     ?6) ; digit
 378                   ("ฯๆ฿๏๚๛" "_"     ?5) ; symbol
 379                   ))
 380       elm chars len syntax category to ch i)
 381   (while deflist
 382     (setq elm (car deflist))
 383     (setq chars (car elm)
 384           len (length chars)
 385           syntax (nth 1 elm)
 386           category (nth 2 elm)
 387           i 0)
 388     (while (< i len)
 389       (if (= (aref chars i) ?-)
 390           (setq i (1+ i)
 391                 to (aref chars i))
 392         (setq ch (aref chars i)
 393               to ch))
 394       (while (<= ch to)
 395         (unless (string-equal syntax "w")
 396           (modify-syntax-entry ch syntax))
 397         (modify-category-entry ch category)
 398         (setq ch (1+ ch)))
 399       (setq i (1+ i)))
 400     (setq deflist (cdr deflist))))
 401
 402 ;; Tibetan character set
 403
 404 (modify-category-entry '(#xf00 . #xfff) ?q)
 405 (map-charset-chars #'modify-category-entry 'tibetan ?q)
 406 (map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
 407
 408 (let ((deflist  '(;; chars             syntax category
 409                   ("ཀ-ཀྵཪ"         "w"     ?0) ; consonant
 410                   ("ྐ-ྐྵྺྻྼ"       "w"     ?0) ;
 411                   ("ིེཻོཽྀ"       "w"       ?2) ; upper vowel
 412                   ("ཾྂྃ྆྇ྈྉྊྋ" "w"    ?2) ; upper modifier
 413                   ("྄ཱུ༙༵༷"       "w"       ?3) ; lowel vowel/modifier
 414                   ("཰"                "w" ?3)             ; invisible vowel a
 415                   ("༠-༩༪-༳"             "w"     ?6) ; digit
 416                   ("་།-༒༔ཿ"        "."     ?|) ; line-break char
 417                   ("་།༏༐༑༔ཿ"            "."     ?|) ;
 418                   ("༈་།-༒༔ཿ༽༴"  "."     ?>) ; prohibition
 419                   ("་།༏༐༑༔ཿ"            "."     ?>) ;
 420                   ("ༀ-༊༼࿁࿂྅"      "."     ?<) ; prohibition
 421                   ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-࿏" "." ?q) ; others
 422                   ))
 423       elm chars len syntax category to ch i)
 424   (while deflist
 425     (setq elm (car deflist))
 426     (setq chars (car elm)
 427           len (length chars)
 428           syntax (nth 1 elm)
 429           category (nth 2 elm)
 430           i 0)
 431     (while (< i len)
 432       (if (= (aref chars i) ?-)
 433           (setq i (1+ i)
 434                 to (aref chars i))
 435         (setq ch (aref chars i)
 436               to ch))
 437       (while (<= ch to)
 438         (unless (string-equal syntax "w")
 439           (modify-syntax-entry ch syntax))
 440         (modify-category-entry ch category)
 441         (setq ch (1+ ch)))
 442       (setq i (1+ i)))
 443     (setq deflist (cdr deflist))))
 444
 445 ;; Vietnamese character set
 446
 447 ;; To make a word with Latin characters
 448 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
 449 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
 450
 451 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
 452 (map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
 453
 454 (let ((tbl (standard-case-table))
 455       (i 32))
 456   (while (< i 128)
 457     (let* ((char (decode-char 'vietnamese-viscii-upper i))
 458            (charl (decode-char 'vietnamese-viscii-lower i))
 459            (uc (encode-char char 'ucs))
 460            (lc (encode-char charl 'ucs)))
 461       (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
 462                             tbl)
 463       (if uc (modify-category-entry uc ?v))
 464       (if lc (modify-category-entry lc ?v)))
 465     (setq i (1+ i))))
 466
 467 ;; Tai Viet
 468 (let ((deflist '(;; chars       syntax  category
 469                  ((?ꪀ.  ?ꪯ) "w"     ?0) ; cosonant
 470                  ("ꪱꪵꪶ"           "w"     ?1) ; vowel base
 471                  ((?ꪹ . ?ꪽ) "w"     ?1) ; vowel base
 472                  ("ꪰꪲꪳꪷꪸꪾ"  "w"     ?2) ; vowel upper
 473                  ("ꪴ"         "w"     ?3) ; vowel lower
 474                  ("ꫀꫂ"              "w"     ?1) ; non-combining tone-mark
 475                  ("꪿꫁"              "w"     ?4) ; combining tone-mark
 476                  ((?ꫛ . ?꫟) "_"     ?5) ; symbol
 477                  )))
 478   (dolist (elm deflist)
 479     (let ((chars (car elm))
 480           (syntax (nth 1 elm))
 481           (category (nth 2 elm)))
 482       (if (consp chars)
 483           (progn
 484             (modify-syntax-entry chars syntax)
 485             (modify-category-entry chars category))
 486         (mapc #'(lambda (x)
 487                   (modify-syntax-entry x syntax)
 488                   (modify-category-entry x category))
 489               chars)))))
 490
 491 ;; Bidi categories
 492
 493 (map-char-table (lambda (key val)
 494                   (cond
 495                    ((memq val '(R AL RLO RLE))
 496                     (modify-category-entry key ?R))
 497                    ((memq val '(L LRE LRO))
 498                     (modify-category-entry key ?L))))
 499                 (unicode-property-table-internal 'bidi-class))
 500
 501 ;; Latin
 502
 503 (modify-category-entry '(#x80 . #x024F) ?l)
 504
 505 (let ((tbl (standard-case-table)) c)
 506
 507   ;; Latin-1
 508
 509   ;; Fixme: Some of the non-word syntaxes here perhaps should be
 510   ;; reviewed.  (Note that the following all implicitly have word
 511   ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.)  There should be a well-defined way of
 512   ;; relating Unicode categories to Emacs syntax codes.
 513
 514   ;; NBSP isn't semantically interchangeable with other whitespace chars,
 515   ;; so it's more like punctation.
 516   (set-case-syntax ?  "." tbl)
 517   (set-case-syntax ?¡ "." tbl)
 518   (set-case-syntax ?¦ "_" tbl)
 519   (set-case-syntax ?§ "." tbl)
 520   (set-case-syntax ?© "_" tbl)
 521   (set-case-syntax-delims 171 187 tbl)  ; « »
 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   (set-case-syntax ?µ "_" tbl)
 528   (set-case-syntax ?· "_" tbl)
 529   (set-case-syntax ?¼ "_" tbl)
 530   (set-case-syntax ?½ "_" tbl)
 531   (set-case-syntax ?¾ "_" tbl)
 532   (set-case-syntax ?¿ "." tbl)
 533   (let ((c 192))
 534     (while (<= c 222)
 535       (set-case-syntax-pair c (+ c 32) tbl)
 536       (setq c (1+ c))))
 537   (set-case-syntax ?× "_" tbl)
 538   (set-case-syntax ?ß "w" tbl)
 539   (set-case-syntax ?÷ "_" tbl)
 540   ;; See below for ÿ.
 541
 542   ;; Latin Extended-A, Latin Extended-B
 543   (setq c #x0100)
 544   (while (<= c #x02B8)
 545     (modify-category-entry c ?l)
 546     (setq c (1+ c)))
 547
 548   (let ((pair-ranges '((#x0100 . #x012F)
 549                        (#x0132 . #x0137)
 550                        (#x0139 . #x0148)
 551                        (#x014a . #x0177)
 552                        (#x0179 . #x017E)
 553                        (#x0182 . #x0185)
 554                        (#x0187 . #x0188)
 555                        (#x018B . #x018C)
 556                        (#x0191 . #x0192)
 557                        (#x0198 . #x0199)
 558                        (#x01A0 . #x01A5)
 559                        (#x01A7 . #x01A8)
 560                        (#x01AC . #x01AD)
 561                        (#x01AF . #x01B0)
 562                        (#x01B3 . #x01B6)
 563                        (#x01BC . #x01BD)
 564                        (#x01CD . #x01DC)
 565                        (#x01DE . #x01EF)
 566                        (#x01F4 . #x01F5)
 567                        (#x01F8 . #x021F)
 568                        (#x0222 . #x0233)
 569                        (#x023B . #x023C)
 570                        (#x0241 . #x0242)
 571                        (#x0246 . #x024F))))
 572     (dolist (elt pair-ranges)
 573       (let ((from (car elt)) (to (cdr elt)))
 574         (while (< from to)
 575           (set-case-syntax-pair from (1+ from) tbl)
 576           (setq from (+ from 2))))))
 577
 578   (set-case-syntax-pair #x189 #x256 tbl)
 579   (set-case-syntax-pair #x18A #x257 tbl)
 580
 581   ;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
 582   ;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
 583   ;; do U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN
 584   ;; SMALL LETTER I.
 585
 586   ;; We used to set up half of those correspondence unconditionally,
 587   ;; but that makes searches slow.  So now we don't set up either half
 588   ;; of these correspondences by default.
 589
 590   ;; (set-downcase-syntax  ?İ ?i tbl)
 591   ;; (set-upcase-syntax    ?I ?ı tbl)
 592
 593   (set-case-syntax-pair ?Ǆ ?ǆ tbl)
 594   (set-case-syntax-pair ?ǅ ?ǆ tbl)
 595   (set-case-syntax-pair ?Ǉ ?ǉ tbl)
 596   (set-case-syntax-pair ?ǈ ?ǉ tbl)
 597   (set-case-syntax-pair ?Ǌ ?ǌ tbl)
 598   (set-case-syntax-pair ?ǋ ?ǌ tbl)
 599
 600   ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
 601   (set-case-syntax-pair ?Ǳ ?ǳ tbl)
 602   (set-case-syntax-pair ?ǲ ?ǳ tbl)
 603   (set-case-syntax-pair ?Ƕ ?ƕ tbl)
 604   (set-case-syntax-pair ?Ƿ ?ƿ tbl)
 605
 606   ;; Latin Extended Additional
 607   (modify-category-entry '(#x1e00 . #x1ef9) ?l)
 608   (setq c #x1e00)
 609   (while (<= c #x1ef9)
 610     (and (zerop (% c 2))
 611          (or (<= c #x1e94) (>= c #x1ea0))
 612          (set-case-syntax-pair c (1+ c) tbl))
 613     (setq c (1+ c)))
 614
 615   ;; Greek
 616   (modify-category-entry '(#x0370 . #x03ff) ?g)
 617   (setq c #x0370)
 618   (while (<= c #x03ff)
 619     (if (or (and (>= c #x0391) (<= c #x03a1))
 620             (and (>= c #x03a3) (<= c #x03ab)))
 621         (set-case-syntax-pair c (+ c 32) tbl))
 622     (and (>= c #x03da)
 623          (<= c #x03ee)
 624          (zerop (% c 2))
 625          (set-case-syntax-pair c (1+ c) tbl))
 626     (setq c (1+ c)))
 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   (set-case-syntax-pair ?Ό ?ό tbl)
 632   (set-case-syntax-pair ?Ύ ?ύ tbl)
 633   (set-case-syntax-pair ?Ώ ?ώ tbl)
 634
 635   ;; Armenian
 636   (setq c #x531)
 637   (while (<= c #x556)
 638     (set-case-syntax-pair c (+ c #x30) tbl)
 639     (setq c (1+ c)))
 640
 641   ;; Greek Extended
 642   (modify-category-entry '(#x1f00 . #x1fff) ?g)
 643   (setq c #x1f00)
 644   (while (<= c #x1fff)
 645     (and (<= (logand c #x000f) 7)
 646          (<= c #x1fa7)
 647          (not (memq c '(#x1f16 #x1f17 #x1f56 #x1f57
 648                                #x1f50 #x1f52 #x1f54 #x1f56)))
 649          (/= (logand c #x00f0) #x70)
 650          (set-case-syntax-pair (+ c 8) c tbl))
 651     (setq c (1+ c)))
 652   (set-case-syntax-pair ?Ᾰ ?ᾰ tbl)
 653   (set-case-syntax-pair ?Ᾱ ?ᾱ tbl)
 654   (set-case-syntax-pair ?Ὰ ?ὰ tbl)
 655   (set-case-syntax-pair ?Ά ?ά tbl)
 656   (set-case-syntax-pair ?ᾼ ?ᾳ tbl)
 657   (set-case-syntax-pair ?Ὲ ?ὲ tbl)
 658   (set-case-syntax-pair ?Έ ?έ tbl)
 659   (set-case-syntax-pair ?Ὴ ?ὴ tbl)
 660   (set-case-syntax-pair ?Ή ?ή tbl)
 661   (set-case-syntax-pair ?ῌ ?ῃ tbl)
 662   (set-case-syntax-pair ?Ῐ ?ῐ tbl)
 663   (set-case-syntax-pair ?Ῑ ?ῑ tbl)
 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   (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
 677   ;; cyrillic
 678   (modify-category-entry '(#x0400 . #x04FF) ?y)
 679   (setq c #x0400)
 680   (while (<= c #x04ff)
 681     (and (>= c #x0400)
 682          (<= c #x040f)
 683          (set-case-syntax-pair c (+ c 80) tbl))
 684     (and (>= c #x0410)
 685          (<= c #x042f)
 686          (set-case-syntax-pair c (+ c 32) tbl))
 687     (and (zerop (% c 2))
 688          (or (and (>= c #x0460) (<= c #x0480))
 689              (and (>= c #x048c) (<= c #x04be))
 690              (and (>= c #x04d0) (<= c #x04f4)))
 691          (set-case-syntax-pair c (1+ c) tbl))
 692     (setq c (1+ c)))
 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
 699   ;; general punctuation
 700   (setq c #x2000)
 701   (while (<= c #x200b)
 702     (set-case-syntax c " " tbl)
 703     (setq c (1+ c)))
 704   (while (<= c #x200F)
 705     (set-case-syntax c "." tbl)
 706     (setq c (1+ c)))
 707   ;; Fixme: These aren't all right:
 708   (setq c #x2010)
 709   (while (<= c #x2016)
 710     (set-case-syntax c "_" tbl)
 711     (setq c (1+ c)))
 712   ;; Punctuation syntax for quotation marks (like `)
 713   (while (<= c #x201f)
 714     (set-case-syntax  c "." tbl)
 715     (setq c (1+ c)))
 716   ;; Fixme: These aren't all right:
 717   (while (<= c #x2027)
 718     (set-case-syntax c "_" tbl)
 719     (setq c (1+ c)))
 720   (while (<= c #x206F)
 721     (set-case-syntax c "." tbl)
 722     (setq c (1+ c)))
 723
 724   ;; Roman numerals
 725   (setq c #x2160)
 726   (while (<= c #x216f)
 727     (set-case-syntax-pair c (+ c #x10) tbl)
 728     (setq c (1+ c)))
 729
 730   ;; Fixme: The following blocks might be better as symbol rather than
 731   ;; punctuation.
 732   ;; Arrows
 733   (setq c #x2190)
 734   (while (<= c #x21FF)
 735     (set-case-syntax c "." tbl)
 736     (setq c (1+ c)))
 737   ;; Mathematical Operators
 738   (while (<= c #x22FF)
 739     (set-case-syntax c "." tbl)
 740     (setq c (1+ c)))
 741   ;; Miscellaneous Technical
 742   (while (<= c #x23FF)
 743     (set-case-syntax c "." tbl)
 744     (setq c (1+ c)))
 745   ;; Control Pictures
 746   (while (<= c #x243F)
 747     (set-case-syntax c "_" tbl)
 748     (setq c (1+ c)))
 749
 750   ;; Circled Latin
 751   (setq c #x24b6)
 752   (while (<= c #x24cf)
 753     (set-case-syntax-pair c (+ c 26) tbl)
 754     (modify-category-entry c ?l)
 755     (modify-category-entry (+ c 26) ?l)
 756     (setq c (1+ c)))
 757
 758   ;; Fullwidth Latin
 759   (setq c #xff21)
 760   (while (<= c #xff3a)
 761     (set-case-syntax-pair c (+ c #x20) tbl)
 762     (modify-category-entry c ?l)
 763     (modify-category-entry (+ c #x20) ?l)
 764     (setq c (1+ c)))
 765
 766   ;; Combining diacritics
 767   (modify-category-entry '(#x300 . #x362) ?^)
 768   ;; Combining marks
 769   (modify-category-entry '(#x20d0 . #x20e3) ?^)
 770
 771   ;; Fixme: syntax for symbols &c
 772   )
 773
 774 (let ((pairs
 775        '("⁅⁆"                               ; U+2045 U+2046
 776          "⁽⁾"                               ; U+207D U+207E
 777          "₍₎"                               ; U+208D U+208E
 778          "〈〉"                               ; U+2329 U+232A
 779          "⎴⎵"                               ; U+23B4 U+23B5
 780          "❨❩"                               ; U+2768 U+2769
 781          "❪❫"                               ; U+276A U+276B
 782          "❬❭"                               ; U+276C U+276D
 783          "❰❱"                               ; U+2770 U+2771
 784          "❲❳"                               ; U+2772 U+2773
 785          "❴❵"                               ; U+2774 U+2775
 786          "⟦⟧"                               ; U+27E6 U+27E7
 787          "⟨⟩"                               ; U+27E8 U+27E9
 788          "⟪⟫"                               ; U+27EA U+27EB
 789          "⦃⦄"                               ; U+2983 U+2984
 790          "⦅⦆"                               ; U+2985 U+2986
 791          "⦇⦈"                               ; U+2987 U+2988
 792          "⦉⦊"                               ; U+2989 U+298A
 793          "⦋⦌"                               ; U+298B U+298C
 794          "⦍⦎"                               ; U+298D U+298E
 795          "⦏⦐"                               ; U+298F U+2990
 796          "⦑⦒"                               ; U+2991 U+2992
 797          "⦓⦔"                               ; U+2993 U+2994
 798          "⦕⦖"                               ; U+2995 U+2996
 799          "⦗⦘"                               ; U+2997 U+2998
 800          "⧼⧽"                               ; U+29FC U+29FD
 801          "〈〉"                               ; U+3008 U+3009
 802          "《》"                               ; U+300A U+300B
 803          "「」"                               ; U+300C U+300D
 804          "『』"                               ; U+300E U+300F
 805          "【】"                               ; U+3010 U+3011
 806          "〔〕"                               ; U+3014 U+3015
 807          "〖〗"                               ; U+3016 U+3017
 808          "〘〙"                               ; U+3018 U+3019
 809          "〚〛"                               ; U+301A U+301B
 810          "﴾﴿"                               ; U+FD3E U+FD3F
 811          "︵︶"                               ; U+FE35 U+FE36
 812          "︷︸"                               ; U+FE37 U+FE38
 813          "︹︺"                               ; U+FE39 U+FE3A
 814          "︻︼"                               ; U+FE3B U+FE3C
 815          "︽︾"                               ; U+FE3D U+FE3E
 816          "︿﹀"                               ; U+FE3F U+FE40
 817          "﹁﹂"                               ; U+FE41 U+FE42
 818          "﹃﹄"                               ; U+FE43 U+FE44
 819          "﹙﹚"                               ; U+FE59 U+FE5A
 820          "﹛﹜"                               ; U+FE5B U+FE5C
 821          "﹝﹞"                               ; U+FE5D U+FE5E
 822          "（）"                               ; U+FF08 U+FF09
 823          "［］"                               ; U+FF3B U+FF3D
 824          "｛｝"                               ; U+FF5B U+FF5D
 825          "｟｠"                               ; U+FF5F U+FF60
 826          "｢｣"                               ; U+FF62 U+FF63
 827          )))
 828   (dolist (elt pairs)
 829     (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
 830     (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
 831
 832 \f
 833 ;; For each character set, put the information of the most proper
 834 ;; coding system to encode it by `preferred-coding-system' property.
 835
 836 ;; Fixme: should this be junked?
 837 (let ((l '((latin-iso8859-1     . iso-latin-1)
 838            (latin-iso8859-2     . iso-latin-2)
 839            (latin-iso8859-3     . iso-latin-3)
 840            (latin-iso8859-4     . iso-latin-4)
 841            (thai-tis620         . thai-tis620)
 842            (greek-iso8859-7     . greek-iso-8bit)
 843            (arabic-iso8859-6    . iso-2022-7bit)
 844            (hebrew-iso8859-8    . hebrew-iso-8bit)
 845            (katakana-jisx0201   . japanese-shift-jis)
 846            (latin-jisx0201      . japanese-shift-jis)
 847            (cyrillic-iso8859-5  . cyrillic-iso-8bit)
 848            (latin-iso8859-9     . iso-latin-5)
 849            (japanese-jisx0208-1978 . iso-2022-jp)
 850            (chinese-gb2312      . chinese-iso-8bit)
 851            (chinese-gbk         . chinese-gbk)
 852            (gb18030-2-byte      . chinese-gb18030)
 853            (gb18030-4-byte-bmp  . chinese-gb18030)
 854            (gb18030-4-byte-smp  . chinese-gb18030)
 855            (gb18030-4-byte-ext-1 . chinese-gb18030)
 856            (gb18030-4-byte-ext-2 . chinese-gb18030)
 857            (japanese-jisx0208   . iso-2022-jp)
 858            (korean-ksc5601      . iso-2022-kr)
 859            (japanese-jisx0212   . iso-2022-jp)
 860            (chinese-big5-1      . chinese-big5)
 861            (chinese-big5-2      . chinese-big5)
 862            (chinese-sisheng     . iso-2022-7bit)
 863            (ipa                 . iso-2022-7bit)
 864            (vietnamese-viscii-lower . vietnamese-viscii)
 865            (vietnamese-viscii-upper . vietnamese-viscii)
 866            (arabic-digit        . iso-2022-7bit)
 867            (arabic-1-column     . iso-2022-7bit)
 868            (lao                 . lao)
 869            (arabic-2-column     . iso-2022-7bit)
 870            (indian-is13194      . devanagari)
 871            (indian-glyph        . devanagari)
 872            (tibetan-1-column    . tibetan)
 873            (ethiopic            . iso-2022-7bit)
 874            (chinese-cns11643-1  . iso-2022-cn)
 875            (chinese-cns11643-2  . iso-2022-cn)
 876            (chinese-cns11643-3  . iso-2022-cn)
 877            (chinese-cns11643-4  . iso-2022-cn)
 878            (chinese-cns11643-5  . iso-2022-cn)
 879            (chinese-cns11643-6  . iso-2022-cn)
 880            (chinese-cns11643-7  . iso-2022-cn)
 881            (indian-2-column     . devanagari)
 882            (tibetan             . tibetan)
 883            (latin-iso8859-14    . iso-latin-8)
 884            (latin-iso8859-15    . iso-latin-9))))
 885   (while l
 886     (put-charset-property (car (car l)) 'preferred-coding-system (cdr (car l)))
 887     (setq l (cdr l))))
 888
 889 \f
 890 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
 891 ;; SPACE and NEWLINE are already set.
 892
 893 (set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
 894 (set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
 895 (set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
 896 (set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
 897 (set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
 898 (set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
 899
 900 \f
 901 ;;; Setting char-width-table.  The default is 1.
 902
 903 ;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
 904 ;;    and final characters.
 905 (let ((l '((#x0300 . #x036F)
 906            (#x0483 . #x0489)
 907            (#x0591 . #x05BD)
 908            (#x05BF . #x05BF)
 909            (#x05C1 . #x05C2)
 910            (#x05C4 . #x05C5)
 911            (#x05C7 . #x05C7)
 912            (#x0600 . #x0603)
 913            (#x0610 . #x0615)
 914            (#x064B . #x065E)
 915            (#x0670 . #x0670)
 916            (#x06D6 . #x06E4)
 917            (#x06E7 . #x06E8)
 918            (#x06EA . #x06ED)
 919            (#x070F . #x070F)
 920            (#x0711 . #x0711)
 921            (#x0730 . #x074A)
 922            (#x07A6 . #x07B0)
 923            (#x07EB . #x07F3)
 924            (#x0901 . #x0902)
 925            (#x093C . #x093C)
 926            (#x0941 . #x0948)
 927            (#x094D . #x094D)
 928            (#x0951 . #x0954)
 929            (#x0962 . #x0963)
 930            (#x0981 . #x0981)
 931            (#x09BC . #x09BC)
 932            (#x09C1 . #x09C4)
 933            (#x09CD . #x09CD)
 934            (#x09E2 . #x09E3)
 935            (#x0A01 . #x0A02)
 936            (#x0A3C . #x0A3C)
 937            (#x0A41 . #x0A4D)
 938            (#x0A70 . #x0A71)
 939            (#x0A81 . #x0A82)
 940            (#x0ABC . #x0ABC)
 941            (#x0AC1 . #x0AC8)
 942            (#x0ACD . #x0ACD)
 943            (#x0AE2 . #x0AE3)
 944            (#x0B01 . #x0B01)
 945            (#x0B3C . #x0B3C)
 946            (#x0B3F . #x0B3F)
 947            (#x0B41 . #x0B43)
 948            (#x0B4D . #x0B56)
 949            (#x0B82 . #x0B82)
 950            (#x0BC0 . #x0BC0)
 951            (#x0BCD . #x0BCD)
 952            (#x0C3E . #x0C40)
 953            (#x0C46 . #x0C56)
 954            (#x0CBC . #x0CBC)
 955            (#x0CBF . #x0CBF)
 956            (#x0CC6 . #x0CC6)
 957            (#x0CCC . #x0CCD)
 958            (#x0CE2 . #x0CE3)
 959            (#x0D41 . #x0D43)
 960            (#x0D4D . #x0D4D)
 961            (#x0DCA . #x0DCA)
 962            (#x0DD2 . #x0DD6)
 963            (#x0E31 . #x0E31)
 964            (#x0E34 . #x0E3A)
 965            (#x0E47 . #x0E4E)
 966            (#x0EB1 . #x0EB1)
 967            (#x0EB4 . #x0EBC)
 968            (#x0EC8 . #x0ECD)
 969            (#x0F18 . #x0F19)
 970            (#x0F35 . #x0F35)
 971            (#x0F37 . #x0F37)
 972            (#x0F39 . #x0F39)
 973            (#x0F71 . #x0F7E)
 974            (#x0F80 . #x0F84)
 975            (#x0F86 . #x0F87)
 976            (#x0F90 . #x0FBC)
 977            (#x0FC6 . #x0FC6)
 978            (#x102D . #x1030)
 979            (#x1032 . #x1037)
 980            (#x1039 . #x1039)
 981            (#x1058 . #x1059)
 982            (#x1160 . #x11FF)
 983            (#x135F . #x135F)
 984            (#x1712 . #x1714)
 985            (#x1732 . #x1734)
 986            (#x1752 . #x1753)
 987            (#x1772 . #x1773)
 988            (#x17B4 . #x17B5)
 989            (#x17B7 . #x17BD)
 990            (#x17C6 . #x17C6)
 991            (#x17C9 . #x17D3)
 992            (#x17DD . #x17DD)
 993            (#x180B . #x180D)
 994            (#x18A9 . #x18A9)
 995            (#x1920 . #x1922)
 996            (#x1927 . #x1928)
 997            (#x1932 . #x1932)
 998            (#x1939 . #x193B)
 999            (#x1A17 . #x1A18)
1000            (#x1B00 . #x1B03)
1001            (#x1B34 . #x1B34)
1002            (#x1B36 . #x1B3A)
1003            (#x1B3C . #x1B3C)
1004            (#x1B42 . #x1B42)
1005            (#x1B6B . #x1B73)
1006            (#x1DC0 . #x1DFF)
1007            (#x200B . #x200F)
1008            (#x202A . #x202E)
1009            (#x2060 . #x206F)
1010            (#x20D0 . #x20EF)
1011            (#x302A . #x302F)
1012            (#x3099 . #x309A)
1013            (#xA806 . #xA806)
1014            (#xA80B . #xA80B)
1015            (#xA825 . #xA826)
1016            (#xFB1E . #xFB1E)
1017            (#xFE00 . #xFE0F)
1018            (#xFE20 . #xFE23)
1019            (#xFEFF . #xFEFF)
1020            (#xFFF9 . #xFFFB)
1021            (#x10A01 . #x10A0F)
1022            (#x10A38 . #x10A3F)
1023            (#x1D167 . #x1D169)
1024            (#x1D173 . #x1D182)
1025            (#x1D185 . #x1D18B)
1026            (#x1D1AA . #x1D1AD)
1027            (#x1D242 . #x1D244)
1028            (#xE0001 . #xE01EF))))
1029   (dolist (elt l)
1030     (set-char-table-range char-width-table elt 0)))
1031
1032 ;; 2: East Asian Wide and Full-width characters.
1033 (let ((l '((#x1100 . #x115F)
1034            (#x2329 . #x232A)
1035            (#x2E80 . #x303E)
1036            (#x3040 . #xA4CF)
1037            (#xAC00 . #xD7A3)
1038            (#xF900 . #xFAFF)
1039            (#xFE30 . #xFE6F)
1040            (#xFF01 . #xFF60)
1041            (#xFFE0 . #xFFE6)
1042            (#x20000 . #x2FFFF)
1043            (#x30000 . #x3FFFF))))
1044   (dolist (elt l)
1045     (set-char-table-range char-width-table elt 2)))
1046
1047 ;; Other double width
1048 ;;(map-charset-chars
1049 ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
1050 ;; 'ethiopic)
1051 ;; (map-charset-chars
1052 ;;  (lambda (range ignore) (set-char-table-range char-width-table range 2))
1053 ;; 'tibetan)
1054 (map-charset-chars
1055  (lambda (range ignore) (set-char-table-range char-width-table range 2))
1056  'indian-2-column)
1057 (map-charset-chars
1058  (lambda (range ignore) (set-char-table-range char-width-table range 2))
1059  'arabic-2-column)
1060
1061 ;; Internal use only.
1062 ;; Alist of locale symbol vs charsets.  In a language environment
1063 ;; corresponding to the locale, width of characters in the charsets is
1064 ;; set to 2.  Each element has the form:
1065 ;;   (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
1066 ;; LOCALE: locale symbol
1067 ;; TABLE: char-table used for char-width-table, initially nil.
1068 ;; CAHRSET: character set
1069 ;; FROM-CODE, TO-CODE: range of code-points in CHARSET
1070
1071 (defvar cjk-char-width-table-list
1072   '((ja_JP nil (japanese-jisx0208 (#x2121 . #x287E))
1073                (cp932-2-byte (#x8140 . #x879F)))
1074     (zh_CN nil (chinese-gb2312 (#x2121 . #x297E)))
1075     (zh_HK nil (big5-hkscs (#xA140 . #xA3FE) (#xC6A0 . #xC8FE)))
1076     (zh_TW nil (big5 (#xA140 . #xA3FE))
1077                (chinese-cns11643-1 (#x2121 . #x427E)))
1078     (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E)))))
1079
1080 ;; Internal use only.
1081 ;; Setup char-width-table appropriate for a language environment
1082 ;; corresponding to LOCALE-NAME (symbol).
1083
1084 (defun use-cjk-char-width-table (locale-name)
1085   (while (char-table-parent char-width-table)
1086     (setq char-width-table (char-table-parent char-width-table)))
1087   (let ((slot (assq locale-name cjk-char-width-table-list))
1088         table)
1089     (or slot (error "Unknown locale for CJK language environment: %s"
1090                     locale-name))
1091     (unless (nth 1 slot)
1092       (let ((table (make-char-table nil)))
1093         (dolist (charset-info (nthcdr 2 slot))
1094           (let ((charset (car charset-info)))
1095             (dolist (code-range (cdr charset-info))
1096               (map-charset-chars #'(lambda (range arg)
1097                                      (set-char-table-range table range 2))
1098                                  charset nil
1099                                  (car code-range) (cdr code-range)))))
1100         (optimize-char-table table)
1101         (set-char-table-parent table char-width-table)
1102         (setcar (cdr slot) table)))
1103     (setq char-width-table (nth 1 slot))))
1104
1105 (defun use-default-char-width-table ()
1106   "Internal use only.
1107 Setup char-width-table appropriate for non-CJK language environment."
1108   (while (char-table-parent char-width-table)
1109     (setq char-width-table (char-table-parent char-width-table))))
1110
1111 (optimize-char-table (standard-case-table))
1112 (optimize-char-table (standard-syntax-table))
1113
1114 \f
1115 ;; Setting char-script-table.
1116
1117 ;; The Unicode blocks actually extend past some of these ranges with
1118 ;; undefined codepoints.
1119 (let ((script-list nil))
1120   (dolist
1121       (elt
1122        '((#x0000 #x007F latin)
1123          (#x00A0 #x024F latin)
1124          (#x0250 #x02AF phonetic)
1125          (#x02B0 #x036F latin)
1126          (#x0370 #x03E1 greek)
1127          (#x03E2 #x03EF coptic)
1128          (#x03F0 #x03F3 greek)
1129          (#x0400 #x04FF cyrillic)
1130          (#x0530 #x058F armenian)
1131          (#x0590 #x05FF hebrew)
1132          (#x0600 #x06FF arabic)
1133          (#x0700 #x074F syriac)
1134          (#x07C0 #x07FA nko)
1135          (#x0780 #x07BF thaana)
1136          (#x0900 #x097F devanagari)
1137          (#x0980 #x09FF bengali)
1138          (#x0A00 #x0A7F gurmukhi)
1139          (#x0A80 #x0AFF gujarati)
1140          (#x0B00 #x0B7F oriya)
1141          (#x0B80 #x0BFF tamil)
1142          (#x0C00 #x0C7F telugu)
1143          (#x0C80 #x0CFF kannada)
1144          (#x0D00 #x0D7F malayalam)
1145          (#x0D80 #x0DFF sinhala)
1146          (#x0E00 #x0E5F thai)
1147          (#x0E80 #x0EDF lao)
1148          (#x0F00 #x0FFF tibetan)
1149          (#x1000 #x109F burmese)
1150          (#x10A0 #x10FF georgian)
1151          (#x1100 #x11FF hangul)
1152          (#x1200 #x139F ethiopic)
1153          (#x13A0 #x13FF cherokee)
1154          (#x1400 #x167F canadian-aboriginal)
1155          (#x1680 #x169F ogham)
1156          (#x16A0 #x16FF runic)
1157          (#x1780 #x17FF khmer)
1158          (#x1800 #x18AF mongolian)
1159          (#x1D00 #x1DFF phonetic)
1160          (#x1E00 #x1EFF latin)
1161          (#x1F00 #x1FFF greek)
1162          (#x2000 #x27FF symbol)
1163          (#x2800 #x28FF braille)
1164          (#x2D80 #x2DDF ethiopic)
1165          (#x2E80 #x2FDF han)
1166          (#x2FF0 #x2FFF ideographic-description)
1167          (#x3000 #x303F cjk-misc)
1168          (#x3040 #x30FF kana)
1169          (#x3100 #x312F bopomofo)
1170          (#x3130 #x318F hangul)
1171          (#x3190 #x319F kanbun)
1172          (#x31A0 #x31BF bopomofo)
1173          (#x3400 #x9FAF han)
1174          (#xA000 #xA4CF yi)
1175          (#xAA00 #xAA5F cham)
1176          (#xAA60 #xAA7B burmese)
1177          (#xAA80 #xAADF tai-viet)
1178          (#xAC00 #xD7AF hangul)
1179          (#xF900 #xFAFF han)
1180          (#xFB1D #xFB4F hebrew)
1181          (#xFB50 #xFDFF arabic)
1182          (#xFE70 #xFEFC arabic)
1183          (#xFF00 #xFF5F cjk-misc)
1184          (#xFF61 #xFF9F kana)
1185          (#xFFE0 #xFFE6 cjk-misc)
1186          (#x10000 #x100FF linear-b)
1187          (#x10100 #x1013F aegean-number)
1188          (#x10140 #x1018A ancient-greek-number)
1189          (#x10190 #x1019B ancient-symbol)
1190          (#x101D0 #x101FF phaistos-disc)
1191          (#x10280 #x1029F lycian)
1192          (#x102A0 #x102DF carian)
1193          (#x10300 #x1032F olt-italic)
1194          (#x10380 #x1039F ugaritic)
1195          (#x103A0 #x103DF old-persian)
1196          (#x10400 #x1044F deseret)
1197          (#x10450 #x1047F shavian)
1198          (#x10480 #x104AF osmanya)
1199          (#x10800 #x1083F cypriot-syllabary)
1200          (#x10900 #x1091F phoenician)
1201          (#x10920 #x1093F lydian)
1202          (#x10A00 #x10A5F kharoshthi)
1203          (#x12000 #x123FF cuneiform)
1204          (#x12400 #x1247F cuneiform-numbers-and-punctuation)
1205          (#x1D000 #x1D0FF byzantine-musical-symbol)
1206          (#x1D100 #x1D1FF musical-symbol)
1207          (#x1D200 #x1D24F ancient-greek-musical-notation)
1208          (#x1D300 #x1D35F tai-xuan-jing-symbol)
1209          (#x1D360 #x1D37F counting-rod-numeral)
1210          (#x1D400 #x1D7FF mathematical)
1211          (#x1F000 #x1F02F mahjong-tile)
1212          (#x1F030 #x1F09F domino-tile)
1213          (#x20000 #x2AFFF han)
1214          (#x2F800 #x2FFFF han)))
1215     (set-char-table-range char-script-table
1216                           (cons (car elt) (nth 1 elt)) (nth 2 elt))
1217     (or (memq (nth 2 elt) script-list)
1218         (setq script-list (cons (nth 2 elt) script-list))))
1219   (set-char-table-extra-slot char-script-table 0 (nreverse script-list)))
1220
1221 (map-charset-chars
1222  #'(lambda (range ignore)
1223      (set-char-table-range char-script-table range 'tibetan))
1224  'tibetan)
1225
1226 \f
1227 ;;; Setting unicode-category-table.
1228
1229 (setq unicode-category-table
1230       (unicode-property-table-internal 'general-category))
1231 (map-char-table #'(lambda (key val)
1232                     (if (and val
1233                              (or (and (/= (aref (symbol-name val) 0) ?M)
1234                                       (/= (aref (symbol-name val) 0) ?C))
1235                                  (eq val 'Zs)))
1236                         (modify-category-entry key ?.)))
1237                 unicode-category-table)
1238
1239 (optimize-char-table (standard-category-table))
1240
1241 \f
1242 ;; Display of glyphless characters.
1243
1244 (defvar char-acronym-table
1245   (make-char-table 'char-acronym-table nil)
1246   "Char table of acronyms for non-graphic characters.")
1247
1248 (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
1249                      "BS"   nil   nil  "VT"  "FF"  "CR"  "SO"  "SI"
1250                      "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
1251                      "CAN" "EM"  "SUB" "ESC" "FC"  "GS"  "RS"  "US")))
1252   (dotimes (i 32)
1253     (aset char-acronym-table i (car c0-acronyms))
1254     (setq c0-acronyms (cdr c0-acronyms))))
1255
1256 (let ((c1-acronyms '("XXX" "XXX" "BPH" "NBH" "IND" "NEL" "SSA" "ESA"
1257                      "HTS" "HTJ" "VTS" "PLD" "PLU" "R1"  "SS2" "SS1"
1258                      "DCS" "PU1" "PU2" "STS" "CCH" "MW"  "SPA" "EPA"
1259                      "SOS" "XXX" "SC1" "CSI" "ST"  "OSC" "PM"  "APC")))
1260   (dotimes (i 32)
1261     (aset char-acronym-table (+ #x0080 i) (car c1-acronyms))
1262     (setq c1-acronyms (cdr c1-acronyms))))
1263
1264 (aset char-acronym-table #x17B4 "KIVAQ")   ; KHMER VOWEL INHERENT AQ
1265 (aset char-acronym-table #x17B5 "KIVAA")   ; KHMER VOWEL INHERENT AA
1266 (aset char-acronym-table #x200B "ZWSP")    ; ZERO WIDTH SPACE
1267 (aset char-acronym-table #x200C "ZWNJ")    ; ZERO WIDTH NON-JOINER
1268 (aset char-acronym-table #x200D "ZWJ")     ; ZERO WIDTH JOINER
1269 (aset char-acronym-table #x200E "LRM")     ; LEFT-TO-RIGHT MARK
1270 (aset char-acronym-table #x200F "RLM")     ; RIGHT-TO-LEFT MARK
1271 (aset char-acronym-table #x202A "LRE")     ; LEFT-TO-RIGHT EMBEDDING
1272 (aset char-acronym-table #x202B "RLE")     ; RIGHT-TO-LEFT EMBEDDING
1273 (aset char-acronym-table #x202C "PDF")     ; POP DIRECTIONAL FORMATTING
1274 (aset char-acronym-table #x202D "LRO")     ; LEFT-TO-RIGHT OVERRIDE
1275 (aset char-acronym-table #x202E "RLO")     ; RIGHT-TO-LEFT OVERRIDE
1276 (aset char-acronym-table #x2060 "WJ")      ; WORD JOINER
1277 (aset char-acronym-table #x206A "ISS")     ; INHIBIT SYMMETRIC SWAPPING
1278 (aset char-acronym-table #x206B "ASS")     ; ACTIVATE SYMMETRIC SWAPPING
1279 (aset char-acronym-table #x206C "IAFS")    ; INHIBIT ARABIC FORM SHAPING
1280 (aset char-acronym-table #x206D "AAFS")    ; ACTIVATE ARABIC FORM SHAPING
1281 (aset char-acronym-table #x206E "NADS")    ; NATIONAL DIGIT SHAPES
1282 (aset char-acronym-table #x206F "NODS")    ; NOMINAL DIGIT SHAPES
1283 (aset char-acronym-table #xFEFF "ZWNBSP")  ; ZERO WIDTH NO-BREAK SPACE
1284 (aset char-acronym-table #xFFF9 "IAA")     ; INTERLINEAR ANNOTATION ANCHOR
1285 (aset char-acronym-table #xFFFA "IAS")     ; INTERLINEAR ANNOTATION SEPARATOR
1286 (aset char-acronym-table #xFFFB "IAT")     ; INTERLINEAR ANNOTATION TERMINATOR
1287 (aset char-acronym-table #x1D173 "BEGBM")  ; MUSICAL SYMBOL BEGIN BEAM
1288 (aset char-acronym-table #x1D174 "ENDBM")  ; MUSICAL SYMBOL END BEAM
1289 (aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE
1290 (aset char-acronym-table #x1D176 "END")    ; MUSICAL SYMBOL END TIE
1291 (aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR
1292 (aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR
1293 (aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE
1294 (aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE
1295 (aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG
1296 (aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE
1297 (dotimes (i 94)
1298   (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
1299 (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
1300
1301 (defun update-glyphless-char-display (&optional variable value)
1302   "Make the setting of `glyphless-char-display-control' take effect.
1303 This function updates the char-table `glyphless-char-display'."
1304   (when value
1305     (set-default variable value))
1306   (dolist (elt value)
1307     (let ((target (car elt))
1308           (method (cdr elt)))
1309       (or (memq method '(zero-width thin-space empty-box acronym hex-code))
1310           (error "Invalid glyphless character display method: %s" method))
1311       (cond ((eq target 'c0-control)
1312              (set-char-table-range glyphless-char-display '(#x00 . #x1F)
1313                                    method)
1314              ;; Users will not expect their newlines and TABs be
1315              ;; displayed as anything but themselves, so exempt those
1316              ;; two characters from c0-control.
1317              (set-char-table-range glyphless-char-display #x9 nil)
1318              (set-char-table-range glyphless-char-display #xa nil))
1319             ((eq target 'c1-control)
1320              (set-char-table-range glyphless-char-display '(#x80 . #x9F)
1321                                    method))
1322             ((eq target 'format-control)
1323              (map-char-table
1324               #'(lambda (char category)
1325                   (if (eq category 'Cf)
1326                       (let ((this-method method)
1327                             from to)
1328                         (if (consp char)
1329                             (setq from (car char) to (cdr char))
1330                           (setq from char to char))
1331                         (while (<= from to)
1332                           (when (/= from #xAD)
1333                             (if (eq method 'acronym)
1334                                 (setq this-method
1335                                       (aref char-acronym-table from)))
1336                             (set-char-table-range glyphless-char-display
1337                                                   from this-method))
1338                           (setq from (1+ from))))))
1339               unicode-category-table))
1340             ((eq target 'no-font)
1341              (set-char-table-extra-slot glyphless-char-display 0 method))
1342             (t
1343              (error "Invalid glyphless character group: %s" target))))))
1344
1345 ;;; Control of displaying glyphless characters.
1346 (defcustom glyphless-char-display-control
1347   '((format-control . thin-space)
1348     (no-font . hex-code))
1349   "List of directives to control display of glyphless characters.
1350
1351 Each element has the form (GROUP . METHOD), where GROUP is a
1352 symbol specifying the character group, and METHOD is a symbol
1353 specifying the method of displaying characters belonging to that
1354 group.
1355
1356 GROUP must be one of these symbols:
1357   `c0-control':     U+0000..U+001F, but excluding newline and TAB.
1358   `c1-control':     U+0080..U+009F.
1359   `format-control': Characters of Unicode General Category `Cf',
1360                     such as U+200C (ZWNJ), U+200E (LRM), but
1361                     excluding characters that have graphic images,
1362                     such as U+00AD (SHY).
1363   `no-font':        characters for which no suitable font is found.
1364                     For character terminals, characters that cannot
1365                     be encoded by `terminal-coding-system'.
1366
1367 METHOD must be one of these symbols:
1368   `zero-width': don't display.
1369   `thin-space': display a thin (1-pixel width) space.  On character
1370                 terminals, display as 1-character space.
1371   `empty-box':  display an empty box.
1372   `acronym':    display an acronym of the character in a box.  The
1373                 acronym is taken from `char-acronym-table', which see.
1374   `hex-code':   display the hexadecimal character code in a box."
1375
1376   :type '(alist :key-type (symbol :tag "Character Group")
1377                 :value-type (symbol :tag "Display Method"))
1378   :options '((c0-control
1379               (choice (const :tag "Don't display" zero-width)
1380                       (const :tag "Display as thin space" thin-space)
1381                       (const :tag "Display as empty box" empty-box)
1382                       (const :tag "Display acronym" acronym)
1383                       (const :tag "Display hex code in a box" hex-code)))
1384              (c1-control
1385               (choice (const :tag "Don't display" zero-width)
1386                       (const :tag "Display as thin space" thin-space)
1387                       (const :tag "Display as empty box" empty-box)
1388                       (const :tag "Display acronym" acronym)
1389                       (const :tag "Display hex code in a box" hex-code)))
1390              (format-control
1391               (choice (const :tag "Don't display" zero-width)
1392                       (const :tag "Display as thin space" thin-space)
1393                       (const :tag "Display as empty box" empty-box)
1394                       (const :tag "Display acronym" acronym)
1395                       (const :tag "Display hex code in a box" hex-code)))
1396              (no-font
1397               (choice (const :tag "Don't display" zero-width)
1398                       (const :tag "Display as thin space" thin-space)
1399                       (const :tag "Display as empty box" empty-box)
1400                       (const :tag "Display acronym" acronym)
1401                       (const :tag "Display hex code in a box" hex-code))))
1402   :set 'update-glyphless-char-display
1403   :group 'display)
1404
1405 \f
1406 ;;; Setting word boundary.
1407
1408 (setq word-combining-categories
1409       '((nil . ?^)
1410         (?^ . nil)
1411         (?C . ?H)
1412         (?C . ?K)))
1413
1414 (setq word-separating-categories        ;  (2-byte character sets)
1415       '((?H . ?K)                       ; Hiragana - Katakana
1416         ))
1417
1418 ;; Local Variables:
1419 ;; coding: utf-8
1420 ;; End:
1421
1422 ;;; characters.el ends here