emacs / src / charset.c

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
/* Basic multilingual character support.
   Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
   Licensed to the Free Software Foundation.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* At first, see the document in `charset.h' to understand the code in
   this file.  */

#include <stdio.h>

#ifdef emacs

#include <sys/types.h>
#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "disptab.h"

#else  /* not emacs */

#include "mulelib.h"

#endif /* emacs */

Lisp_Object Qcharset, Qascii, Qcomposition;

/* Declaration of special leading-codes.  */
int leading_code_composition;	/* for composite characters */
int leading_code_private_11;	/* for private DIMENSION1 of 1-column */
int leading_code_private_12;	/* for private DIMENSION1 of 2-column */
int leading_code_private_21;	/* for private DIMENSION2 of 1-column */
int leading_code_private_22;	/* for private DIMENSION2 of 2-column */

/* Declaration of special charsets.  */
int charset_ascii;		/* ASCII */
int charset_composition;	/* for a composite character */
int charset_latin_iso8859_1;	/* ISO8859-1 (Latin-1) */
int charset_jisx0208_1978;	/* JISX0208.1978 (Japanese Kanji old set) */
int charset_jisx0208;		/* JISX0208.1983 (Japanese Kanji) */
int charset_katakana_jisx0201;	/* JISX0201.Kana (Japanese Katakana) */
int charset_latin_jisx0201;	/* JISX0201.Roman (Japanese Roman) */
int charset_big5_1;		/* Big5 Level 1 (Chinese Traditional) */
int charset_big5_2;		/* Big5 Level 2 (Chinese Traditional) */

Lisp_Object Qcharset_table;

/* A char-table containing information of each character set.  */
Lisp_Object Vcharset_table;

/* A vector of charset symbol indexed by charset-id.  This is used
   only for returning charset symbol from C functions.  */
Lisp_Object Vcharset_symbol_table;

/* A list of charset symbols ever defined.  */
Lisp_Object Vcharset_list;

/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD.  */
int bytes_by_char_head[256];
int width_by_char_head[256];

/* Mapping table from ISO2022's charset (specified by DIMENSION,
   CHARS, and FINAL-CHAR) to Emacs' charset.  */
int iso_charset_table[2][2][128];

/* Table of pointers to the structure `cmpchar_info' indexed by
   CMPCHAR-ID.  */
struct cmpchar_info **cmpchar_table;
/* The current size of `cmpchar_table'.  */
static int cmpchar_table_size;
/* Number of the current composite characters.  */
int n_cmpchars;

/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR.  */
unsigned char *_fetch_multibyte_char_p;
int _fetch_multibyte_char_len;

#define min(X, Y) ((X) < (Y) ? (X) : (Y))
#define max(X, Y) ((X) > (Y) ? (X) : (Y))

/* Set STR a pointer to the multi-byte form of the character C.  If C
   is not a composite character, the multi-byte form is set in WORKBUF
   and STR points WORKBUF.  The caller should allocate at least 4-byte
   area at WORKBUF in advance.  Returns the length of the multi-byte
   form.  If C is an invalid character to have a multi-byte form,
   signal an error.

   Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
   function directly if C can be an ASCII character.  */

int
non_ascii_char_to_string (c, workbuf, str)
     int c;
     unsigned char *workbuf, **str;
{
  int charset, c1, c2;

  if (COMPOSITE_CHAR_P (c))
    {
      int cmpchar_id = COMPOSITE_CHAR_ID (c);

      if (cmpchar_id < n_cmpchars)
	{
	  *str = cmpchar_table[cmpchar_id]->data;
	  return cmpchar_table[cmpchar_id]->len;
	}
      else
	{
	  error ("Invalid character: %d", c);
	}
    }

  SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
  if (!charset
      || ! CHARSET_DEFINED_P (charset)
      || c1 >= 0 && c1 < 32
      || c2 >= 0 && c2 < 32)
    error ("Invalid character: %d", c);

  *str = workbuf;
  *workbuf++ = CHARSET_LEADING_CODE_BASE (charset);
  if (*workbuf = CHARSET_LEADING_CODE_EXT (charset))
    workbuf++;
  *workbuf++ = c1 | 0x80;
  if (c2 >= 0)
    *workbuf++ = c2 | 0x80;

  return (workbuf - *str);
}

/* Return a non-ASCII character of which multi-byte form is at STR of
   length LEN.  If ACTUAL_LEN is not NULL, the actual length of the
   character is set to the address ACTUAL_LEN.

   Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
   directly if STR can hold an ASCII character.  */

string_to_non_ascii_char (str, len, actual_len)
     unsigned char *str;
     int len, *actual_len;
{
  int charset;
  unsigned char c1, c2;
  register int c;

  if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
    {
      if (actual_len)
	*actual_len = 1;
      return (int) *str;
    }

  c = MAKE_NON_ASCII_CHAR (charset, c1, c2);

  if (actual_len)
    *actual_len = (charset == CHARSET_COMPOSITION
		   ? cmpchar_table[COMPOSITE_CHAR_ID (c)]->len
		   : BYTES_BY_CHAR_HEAD (*str));
  return c;
}

/* Return the length of the multi-byte form at string STR of length LEN.  */
int
multibyte_form_length (str, len)
     unsigned char *str;
     int len;
{
  int charset;
  unsigned char c1, c2;
  register int c;

  if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
    return 1;

  return (charset == CHARSET_COMPOSITION
	  ? cmpchar_table[(c1 << 7) | c2]->len
	  : BYTES_BY_CHAR_HEAD (*str));
}

/* Check if string STR of length LEN contains valid multi-byte form of
   a character.  If valid, charset and position codes of the character
   is set at *CHARSET, *C1, and *C2, and return 0.  If not valid,
   return -1.  This should be used only in the macro SPLIT_STRING
   which checks range of STR in advance.  */

split_non_ascii_string (str, len, charset, c1, c2)
     register unsigned char *str, *c1, *c2;
     register int len, *charset;
{
  register unsigned int cs = *str++;

  if (cs == LEADING_CODE_COMPOSITION)
    {
      int cmpchar_id = str_cmpchar_id (str - 1, len);

      if (cmpchar_id < 0)
	return -1;
      *charset = cs, *c1 = cmpchar_id >> 7, *c2 = cmpchar_id & 0x7F;
    }
  else if ((cs < LEADING_CODE_PRIVATE_11 || (cs = *str++) >= 0xA0)
	   && CHARSET_DEFINED_P (cs))
    {
      *charset = cs;
      if (*str < 0xA0)
	return -1;
      *c1 = (*str++) & 0x7F;
      if (CHARSET_DIMENSION (cs) == 2)
	{
	  if (*str < 0xA0)
	    return -1;
	  *c2 = (*str++) & 0x7F;
	}
    }
  else
    return -1;
  return 0;
}

/* Return a character unified with C (or a character made of CHARSET,
   C1, and C2) in unification table TABLE.  If no unification is found
   in TABLE, return C.  */
unify_char (table, c, charset, c1, c2)
     Lisp_Object table;
     int c, charset, c1, c2;
{
  Lisp_Object ch;
  int alt_charset, alt_c1, alt_c2, dimension;

  if (c < 0) c = MAKE_CHAR (charset, c1, c2);
  if (!CHAR_TABLE_P (table)
      || (ch = Faref (table, make_number (c)), !INTEGERP (ch))
      || XINT (ch) < 0)
    return c;

  SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2);
  dimension = CHARSET_DIMENSION (alt_charset);
  if (dimension == 1 && alt_c1 > 0 || dimension == 2 && alt_c2 > 0)
    /* CH is not a generic character, just return it.  */
    return XFASTINT (ch);

  /* Since CH is a generic character, we must return a specific
     charater which has the same position codes as C from CH.  */
  if (charset < 0)
    SPLIT_CHAR (c, charset, c1, c2);
  if (dimension != CHARSET_DIMENSION (charset))
    /* We can't make such a character because of dimension mismatch.  */
    return c;
  if (!alt_c1) alt_c1 = c1;
  if (!alt_c2) alt_c2 = c2;
  return MAKE_CHAR (alt_charset, c1, c2);
}

/* Update the table Vcharset_table with the given arguments (see the
   document of `define-charset' for the meaning of each argument).
   Several other table contents are also updated.  The caller should
   check the validity of CHARSET-ID and the remaining arguments in
   advance.  */

void
update_charset_table (charset_id, dimension, chars, width, direction,
		      iso_final_char, iso_graphic_plane,
		      short_name, long_name, description)
     Lisp_Object charset_id, dimension, chars, width, direction;
     Lisp_Object iso_final_char, iso_graphic_plane;
     Lisp_Object short_name, long_name, description;
{
  int charset = XINT (charset_id);
  int bytes;
  unsigned char leading_code_base, leading_code_ext;

  if (NILP (CHARSET_TABLE_ENTRY (charset)))
    CHARSET_TABLE_ENTRY (charset)
      = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil);

  /* Get byte length of multibyte form, base leading-code, and
     extended leading-code of the charset.  See the comment under the
     title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h.  */
  bytes = XINT (dimension);
  if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
    {
      /* Official charset, it doesn't have an extended leading-code.  */
      if (charset != CHARSET_ASCII)
	bytes += 1; /* For a base leading-code.  */
      leading_code_base = charset;
      leading_code_ext = 0;
    }
  else
    {
      /* Private charset.  */
      bytes += 2; /* For base and extended leading-codes.  */
      leading_code_base
	= (charset < LEADING_CODE_EXT_12
	   ? LEADING_CODE_PRIVATE_11
	   : (charset < LEADING_CODE_EXT_21
	      ? LEADING_CODE_PRIVATE_12
	      : (charset < LEADING_CODE_EXT_22
		 ? LEADING_CODE_PRIVATE_21
		 : LEADING_CODE_PRIVATE_22)));
      leading_code_ext = charset;
    } 

  CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
  CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
  CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
  CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
  CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
  CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
  CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
    = make_number (leading_code_base);
  CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
    = make_number (leading_code_ext);
  CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
  CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
    = iso_graphic_plane;
  CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
  CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
  CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
  CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;

  {
    /* If we have already defined a charset which has the same
       DIMENSION, CHARS and ISO-FINAL-CHAR but the different
       DIRECTION, we must update the entry REVERSE-CHARSET of both
       charsets.  If there's no such charset, the value of the entry
       is set to nil.  */
    int i;

    for (i = 0; i <= MAX_CHARSET; i++)
      if (!NILP (CHARSET_TABLE_ENTRY (i)))
	{
	  if (CHARSET_DIMENSION (i) == XINT (dimension)
	      && CHARSET_CHARS (i) == XINT (chars)
	      && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
	      && CHARSET_DIRECTION (i) != XINT (direction))
	    {
	      CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
		= make_number (i);
	      CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
	      break;
	    }
	}
    if (i > MAX_CHARSET)
      /* No such a charset.  */
      CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
	= make_number (-1);
  }

  if (charset != CHARSET_ASCII
      && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
    {
      /* Update tables bytes_by_char_head and width_by_char_head.  */
      bytes_by_char_head[leading_code_base] = bytes;
      width_by_char_head[leading_code_base] = XINT (width);

      /* Update table emacs_code_class.  */
      emacs_code_class[charset] = (bytes == 2
				   ? EMACS_leading_code_2
				   : (bytes == 3
				      ? EMACS_leading_code_3
				      : EMACS_leading_code_4));
    }

  /* Update table iso_charset_table.  */
  if (ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
    ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
}

#ifdef emacs

/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
   is invalid.  */
int
get_charset_id (charset_symbol)
     Lisp_Object charset_symbol;
{
  Lisp_Object val;
  int charset;

  return ((SYMBOLP (charset_symbol)
	   && (val = Fget (charset_symbol, Qcharset), VECTORP (val))
	   && (charset = XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]),
	       CHARSET_VALID_P (charset)))
	  ? charset : -1);
}

/* Return an identification number for a new private charset of
   DIMENSION and WIDTH.  If there's no more room for the new charset,
   return 0.  */
Lisp_Object
get_new_private_charset_id (dimension, width)
     int dimension, width;
{
  int charset, from, to;

  if (dimension == 1)
    {
      if (width == 1)
	from = LEADING_CODE_EXT_11, to = LEADING_CODE_EXT_12;
      else
	from = LEADING_CODE_EXT_12, to = LEADING_CODE_EXT_21;
    }
  else
    {
      if (width == 1)
	from = LEADING_CODE_EXT_21, to = LEADING_CODE_EXT_22;
      else
	from = LEADING_CODE_EXT_22, to = LEADING_CODE_EXT_MAX - 1;
    }

  for (charset = from; charset < to; charset++)
    if (!CHARSET_DEFINED_P (charset)) break;

  return make_number (charset < to ? charset : 0);
}

DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
  "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
 treated as a private charset.\n\
INFO-VECTOR is a vector of the format:\n\
   [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
    SHORT-NAME LONG-NAME DESCRIPTION]\n\
The meanings of each elements is as follows:\n\
DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
WIDTH (integer) is the number of columns a character in the charset\n\
occupies on the screen: one of 0, 1, and 2.\n\
\n\
DIRECTION (integer) is the rendering direction of characters in the\n\
charset when rendering.  If 0, render from right to left, else\n\
render from left to right.\n\
\n\
ISO-FINAL-CHAR (character) is the final character of the\n\
corresponding ISO 2022 charset.\n\
\n\
ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
while encoding to variants of ISO 2022 coding system, one of the\n\
following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
\n\
SHORT-NAME (string) is the short name to refer to the charset.\n\
\n\
LONG-NAME (string) is the long name to refer to the charset.\n\
\n\
DESCRIPTION (string) is the description string of the charset.")
  (charset_id, charset_symbol, info_vector)
     Lisp_Object charset_id, charset_symbol, info_vector;
{
  Lisp_Object *vec;

  if (!NILP (charset_id))
    CHECK_NUMBER (charset_id, 0);
  CHECK_SYMBOL (charset_symbol, 1);
  CHECK_VECTOR (info_vector, 2);

  if (! NILP (charset_id))
    {
      if (! CHARSET_VALID_P (XINT (charset_id)))
	error ("Invalid CHARSET: %d", XINT (charset_id));
      else if (CHARSET_DEFINED_P (XINT (charset_id)))
	error ("Already defined charset: %d", XINT (charset_id));
    }

  vec = XVECTOR (info_vector)->contents;
  if (XVECTOR (info_vector)->size != 9
      || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
      || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
      || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
      || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
      || !INTEGERP (vec[4]) || !(XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')
      || !INTEGERP (vec[5]) || !(XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
      || !STRINGP (vec[6])
      || !STRINGP (vec[7])
      || !STRINGP (vec[8]))
    error ("Invalid info-vector argument for defining charset %s",
	   XSYMBOL (charset_symbol)->name->data);

  if (NILP (charset_id))
    {
      charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
      if (XINT (charset_id) == 0)
	error ("There's no room for a new private charset %s",
	       XSYMBOL (charset_symbol)->name->data);
    }

  update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
			vec[4], vec[5], vec[6], vec[7], vec[8]);
  Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id)));
  CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
  Vcharset_list = Fcons (charset_symbol, Vcharset_list);
  return Qnil;
}

DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
       4, 4, 0,
  "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
CHARSET should be defined by `defined-charset' in advance.")
  (dimension, chars, final_char, charset_symbol)
     Lisp_Object dimension, chars, final_char, charset_symbol;
{
  int charset;

  CHECK_NUMBER (dimension, 0);
  CHECK_NUMBER (chars, 1);
  CHECK_NUMBER (final_char, 2);
  CHECK_SYMBOL (charset_symbol, 3);

  if (XINT (dimension) != 1 && XINT (dimension) != 2)
    error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
  if (XINT (chars) != 94 && XINT (chars) != 96)
    error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
  if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
    error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
  if ((charset = get_charset_id (charset_symbol)) < 0)
    error ("Invalid charset %s", XSYMBOL (charset_symbol)->name->data);

  ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
  return Qnil;
}

/* Return number of different charsets in STR of length LEN.  In
   addition, for each found charset N, CHARSETS[N] is set 1.  The
   caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
   It may lookup a unification table TABLE if supplied.  */

int
find_charset_in_str (str, len, charsets, table)
     unsigned char *str;
     int len, *charsets;
     Lisp_Object table;
{
  int num = 0;

  if (! CHAR_TABLE_P (table))
    table = Qnil;

  while (len > 0)
    {
      int bytes = BYTES_BY_CHAR_HEAD (*str);
      int charset;
      
      if (NILP (table))
	charset = CHARSET_AT (str);
      else
	{
	  int c, charset;
	  unsigned char c1, c2;

	  SPLIT_STRING(str, bytes, charset, c1, c2);
	  if ((c = unify_char (table, -1, charset, c1, c2)) >= 0)
	    charset = CHAR_CHARSET (c);
	}

      if (!charsets[charset])
	{
	  charsets[charset] = 1;
	  num += 1;
	}
      str += bytes;
      len -= bytes;
    }
  return num;
}

DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
       2, 3, 0,
  "Return a list of charsets in the region between BEG and END.\n\
BEG and END are buffer positions.\n\
Optional arg TABLE if non-nil is a unification table to look up.")
  (beg, end, table)
     Lisp_Object beg, end, table;
{
  int charsets[MAX_CHARSET + 1];
  int from, to, stop, i;
  Lisp_Object val;

  validate_region (&beg, &end);
  from = XFASTINT (beg);
  stop = to = XFASTINT (end);
  if (from < GPT && GPT < to)
    stop = GPT;
  bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
  while (1)
    {
      find_charset_in_str (POS_ADDR (from), stop - from, charsets, table);
      if (stop < to)
	from = stop, stop = to;
      else
	break;
    }
  val = Qnil;
  for (i = MAX_CHARSET; i >= 0; i--)
    if (charsets[i])
      val = Fcons (CHARSET_SYMBOL (i), val);
  return val;
}

DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
       1, 2, 0,
  "Return a list of charsets in STR.\n\
Optional arg TABLE if non-nil is a unification table to look up.")
  (str, table)
     Lisp_Object str, table;
{
  int charsets[MAX_CHARSET + 1];
  int i;
  Lisp_Object val;

  CHECK_STRING (str, 0);
  bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
  find_charset_in_str (XSTRING (str)->data, XSTRING (str)->size,
		       charsets, table);
  val = Qnil;
  for (i = MAX_CHARSET; i >= 0; i--)
    if (charsets[i])
      val = Fcons (CHARSET_SYMBOL (i), val);
  return val;
}

DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
  "")
  (charset, code1, code2)
     Lisp_Object charset, code1, code2;
{
  CHECK_NUMBER (charset, 0);

  if (NILP (code1))
    XSETFASTINT (code1, 0);
  else
    CHECK_NUMBER (code1, 1);
  if (NILP (code2))
    XSETFASTINT (code2, 0);
  else
    CHECK_NUMBER (code2, 2);

  if (!CHARSET_DEFINED_P (XINT (charset)))
    error ("Invalid charset: %d", XINT (charset));

  return make_number (MAKE_CHAR (XINT (charset), XINT (code1), XINT (code2)));
}

DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
  "Return list of charset and one or two position-codes of CHAR.")
  (ch)
     Lisp_Object ch;
{
  Lisp_Object val;
  int charset, c1, c2;

  CHECK_NUMBER (ch, 0);
  SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
  return (c2 >= 0
	  ? Fcons (CHARSET_SYMBOL (charset),
		   Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
	  : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
}

DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
  "Return charset of CHAR.")
  (ch)
     Lisp_Object ch;
{
  CHECK_NUMBER (ch, 0);

  return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
}

DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
  "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.")
  (dimension, chars, final_char)
     Lisp_Object dimension, chars, final_char;
{
  int charset;

  CHECK_NUMBER (dimension, 0);
  CHECK_NUMBER (chars, 1);
  CHECK_NUMBER (final_char, 2);

  if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
    return Qnil;
  return CHARSET_SYMBOL (charset);
}

DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
  "Return byte length of multi-byte form of CHAR.")
  (ch)
     Lisp_Object ch;
{
  Lisp_Object val;
  int bytes;

  CHECK_NUMBER (ch, 0);
  if (COMPOSITE_CHAR_P (XFASTINT (ch)))
    {
      unsigned int id = COMPOSITE_CHAR_ID (XFASTINT (ch));

      bytes = (id < n_cmpchars ? cmpchar_table[id]->len : 1);
    }
  else
    {
      int charset = CHAR_CHARSET (XFASTINT (ch));

      bytes = CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1;
    }

  XSETFASTINT (val, bytes);
  return val;
}

/* Return the width of character of which multi-byte form starts with
   C.  The width is measured by how many columns occupied on the
   screen when displayed in the current buffer.  */

#define ONE_BYTE_CHAR_WIDTH(c)					     	\
  (c < 0x20							     	\
   ? (c == '\t'							     	\
      ? XFASTINT (current_buffer->tab_width)			     	\
      : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2)))	\
   : (c < 0x7f							     	\
      ? 1							     	\
      : (c == 0x7F						     	\
	 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2)		     	\
	 : ((! NILP (current_buffer->enable_multibyte_characters)    	\
	     && BASE_LEADING_CODE_P (c))			     	\
	    ? WIDTH_BY_CHAR_HEAD (c)				     	\
	    : 4))))						     	\


DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
  "Return width of CHAR when displayed in the current buffer.\n\
The width is measured by how many columns it occupies on the screen.")
  (ch)
       Lisp_Object ch;
{
  Lisp_Object val, disp;
  int c;
  struct Lisp_Char_Table *dp = buffer_display_table ();

  CHECK_NUMBER (ch, 0);

  c = XINT (ch);

  /* Get the way the display table would display it.  */
  disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;

  if (VECTORP (disp))
    XSETINT (val, XVECTOR (disp)->size);
  else if (SINGLE_BYTE_CHAR_P (c))
    XSETINT (val, ONE_BYTE_CHAR_WIDTH (c));
  else if (COMPOSITE_CHAR_P (c))
    {
      int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
      XSETFASTINT (val, (id < n_cmpchars ? cmpchar_table[id]->width : 0));
    }
  else
    {
      int charset = CHAR_CHARSET (c);

      XSETFASTINT (val, CHARSET_WIDTH (charset));
    }
  return val;
}

/* Return width of string STR of length LEN when displayed in the
   current buffer.  The width is measured by how many columns it
   occupies on the screen.  */

int
strwidth (str, len)
     unsigned char *str;
     int len;
{
  unsigned char *endp = str + len;
  int width = 0;
  struct Lisp_Char_Table *dp = buffer_display_table (current_buffer);

  while (str < endp)
    {
      if (*str == LEADING_CODE_COMPOSITION)
	{
	  int id = str_cmpchar_id (str, endp - str);

	  if (id < 0)
	    {
	      width += 4;
	      str++;
	    }
	  else
	    {
	      width += cmpchar_table[id]->width;
	      str += cmpchar_table[id]->len;
	    }
	}
      else
	{
	  Lisp_Object disp;
	  int thiswidth;
	  int c = STRING_CHAR (str, endp - str);

	  /* Get the way the display table would display it.  */
	  if (dp)
	    disp = DISP_CHAR_VECTOR (dp, c);
	  else
	    disp = Qnil;

	  if (VECTORP (disp))
	    thiswidth = XVECTOR (disp)->size;
	  else
	    thiswidth = ONE_BYTE_CHAR_WIDTH (*str);

	  width += thiswidth;
	  str += BYTES_BY_CHAR_HEAD (*str);
	}
    }
  return width;
}

DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
  "Return width of STRING when displayed in the current buffer.\n\
Width is measured by how many columns it occupies on the screen.\n\
When calculating width of a multibyte character in STRING,\n\
only the base leading-code is considered; the validity of\n\
the following bytes is not checked.")
  (str)
     Lisp_Object str;
{
  Lisp_Object val;

  CHECK_STRING (str, 0);
  XSETFASTINT (val, strwidth (XSTRING (str)->data, XSTRING (str)->size));
  return val;
}

DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
  "Return the direction of CHAR.\n\
The returned value is 0 for left-to-right and 1 for right-to-left.")
  (ch)
     Lisp_Object ch;
{
  int charset;

  CHECK_NUMBER (ch, 0);
  charset = CHAR_CHARSET (XFASTINT (ch));
  if (!CHARSET_DEFINED_P (charset))
    error ("Invalid character: %d", XINT (ch));
  return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
}

DEFUN ("chars-in-string", Fchars_in_string, Schars_in_string, 1, 1, 0,
  "Return number of characters in STRING.\n\
When using multibyte characters, this is not the necessarily same as\n\
the length of STRING; the length counts a multibyte characters as\n\
several bytes, but this function counts a multibyte character as one\n\
character.")
  (str)
     Lisp_Object str;
{
  Lisp_Object val;
  unsigned char *p, *endp;
  int chars;

  CHECK_STRING (str, 0);

  p = XSTRING (str)->data; endp = p + XSTRING (str)->size;
  chars = 0;
  while (p < endp)
    {
      if (*p == LEADING_CODE_COMPOSITION)
	{
	  p++;
	  while (p < endp && ! CHAR_HEAD_P (p)) p++;
	}
      else
	p += BYTES_BY_CHAR_HEAD (*p);
      chars++;
    }

  XSETFASTINT (val, chars);
  return val;
}

DEFUN ("chars-in-region", Fchars_in_region, Schars_in_region, 2, 2, 0,
  "Return number of characters between BEG and END.\n\
When using multibyte characters, this is not the necessarily same\n\
as (- END BEG); that subtraction gives you the number of bytes, which\n\
may be more than the number of characters.")
  (beg, end)
     Lisp_Object beg, end;
{
  int from, to, stop;
  Lisp_Object val;
  int chars = 0;
  unsigned char *p, *endp;

  validate_region (&beg, &end);

  from = min (XFASTINT (beg), XFASTINT (end));
  to = max (XFASTINT (beg), XFASTINT (end));
  p = POS_ADDR (from);

  if (from < GPT && GPT <= to)
    {
      stop = GPT;
      endp = GPT_ADDR;
    }
  else
    {
      stop = to;
      endp = POS_ADDR (stop);
    }

  while (1)
    {
      if (p == endp)
	{
	  if (stop == to)
	    break;

	  p = POS_ADDR (stop);
	  stop = to;
	  endp = POS_ADDR (stop);
	}

      if (*p == LEADING_CODE_COMPOSITION)
	{
	  p++;
	  while (p < endp && ! CHAR_HEAD_P (p)) p++;
	}
      else
	p += BYTES_BY_CHAR_HEAD (*p);

      chars++;
    }

  return make_number (chars);
}

DEFUN ("char-boundary-p", Fchar_boundary_p, Schar_boundary_p, 1, 1, 0,
  "Return non-nil value if POS is at character boundary of multibyte form.\n\
When the value is non-nil, it contains some additional information:\n\
 0 if POS is at an ASCII character or at the end of range,\n\
 1 if POS is before a 2-byte length multi-byte form,\n\
 2 if POS is before a 3-byte length multi-byte form,\n\
 3 if POS is before a 4-byte length multi-byte form,\n\
 4 if POS is before a composite character.\n\
If POS is out of range or not at character boundary, return NIL.")
  (pos)
     Lisp_Object pos;
{
  Lisp_Object val;
  int n;

  CHECK_NUMBER_COERCE_MARKER (pos, 0);

  n = XINT (pos);
  if (n < BEGV || n > ZV)
    return Qnil;

  if (n == ZV || NILP (current_buffer->enable_multibyte_characters))
    XSETFASTINT (val, 0);
  else
    {
      unsigned char *p = POS_ADDR (n);

      if (SINGLE_BYTE_CHAR_P (*p))
	XSETFASTINT (val, 0);
      else if (*p == LEADING_CODE_COMPOSITION)
	XSETFASTINT (val, 4);
      else if (BYTES_BY_CHAR_HEAD (*p) > 1)
	XSETFASTINT (val, BYTES_BY_CHAR_HEAD (*p) - 1);
      else
	val = Qnil;
    }
  return val;
}

DEFUN ("concat-chars", Fconcat_chars, Sconcat_chars, 1, MANY, 0,
  "Concatenate all the argument characters and make the result a string.")
  (n, args)
     int n;
     Lisp_Object *args;
{
  int i;
  unsigned char *buf
    = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM * n);
  unsigned char *p = buf;
  Lisp_Object val;

  for (i = 0; i < n; i++)
    {
      int c, len;
      unsigned char *str;

      if (!INTEGERP (args[i]))
	{
	  free (buf);
	  CHECK_NUMBER (args[i], 0);
	}
      c = XINT (args[i]);
      len = CHAR_STRING (c, p, str);
      if (p != str)
	/* C is a composite character.  */
	bcopy (str, p, len);
      p += len;
    }

  val = make_string (buf, p - buf);
  return val;
}

#endif /* emacs */

/*** Composite characters staffs ***/

/* Each composite character is identified by CMPCHAR-ID which is
   assigned when Emacs needs the character code of the composite
   character (e.g. when displaying it on the screen).  See the
   document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
   composite character is represented in Emacs.  */

/* If `static' is defined, it means that it is defined to null string. */
#ifndef static
/* The following function is copied from lread.c.  */
static int
hash_string (ptr, len)
     unsigned char *ptr;
     int len;
{
  register unsigned char *p = ptr;
  register unsigned char *end = p + len;
  register unsigned char c;
  register int hash = 0;

  while (p != end)
    {
      c = *p++;
      if (c >= 0140) c -= 40;
      hash = ((hash<<3) + (hash>>28) + c);
    }
  return hash & 07777777777;
}
#endif

#define CMPCHAR_HASH_TABLE_SIZE 0xFFF

static int *cmpchar_hash_table[CMPCHAR_HASH_TABLE_SIZE];

/* Each element of `cmpchar_hash_table' is a pointer to an array of
   integer, where the 1st element is the size of the array, the 2nd
   element is how many elements are actually used in the array, and
   the remaining elements are CMPCHAR-IDs of composite characters of
   the same hash value.  */
#define CMPCHAR_HASH_SIZE(table) table[0]
#define CMPCHAR_HASH_USED(table) table[1]
#define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]

/* Return CMPCHAR-ID of the composite character in STR of the length
   LEN.  If the composite character has not yet been registered,
   register it in `cmpchar_table' and assign new CMPCHAR-ID.  This
   is the sole function for assigning CMPCHAR-ID.  */
int
str_cmpchar_id (str, len)
     unsigned char *str;
     int len;
{
  int hash_idx, *hashp;
  unsigned char *buf;
  int embedded_rule;		/* 1 if composition rule is embedded.  */
  int chars;			/* number of components.  */
  int i;
  struct cmpchar_info *cmpcharp;

  if (len < 5)
    /* Any composite char have at least 3-byte length.  */
    return -1;

  /* The second byte 0xFF means compostion rule is embedded.  */
  embedded_rule = (str[1] == 0xFF);

  /* At first, get the actual length of the composite character.  */
  {
    unsigned char *p, *endp = str + 1, *lastp = str + len;
    int bytes;

    while (endp < lastp && ! CHAR_HEAD_P (endp)) endp++;
    chars = 0;
    p = str + 1 + embedded_rule;
    while (p < endp)
      {
	/* No need of checking if *P is 0xA0 because
	 BYTES_BY_CHAR_HEAD (0x80) surely returns 2.  */
	p += (bytes = BYTES_BY_CHAR_HEAD (*p - 0x20) + embedded_rule);
	chars++;
      }
    len = (p -= embedded_rule) - str;
    if (p > endp)
      len -= - bytes, chars--;

    if (chars < 2 || chars > MAX_COMPONENT_COUNT)
      /* Invalid number of components.  */
      return -1;
  }
  hash_idx = hash_string (str, len) % CMPCHAR_HASH_TABLE_SIZE;
  hashp = cmpchar_hash_table[hash_idx];

  /* Then, look into the hash table.  */
  if (hashp != NULL)
    /* Find the correct one among composite characters of the same
       hash value.  */
    for (i = 2; i < CMPCHAR_HASH_USED (hashp); i++)
      {
	cmpcharp = cmpchar_table[CMPCHAR_HASH_CMPCHAR_ID (hashp, i)];
	if (len == cmpcharp->len
	    && ! bcmp (str, cmpcharp->data, len))
	  return CMPCHAR_HASH_CMPCHAR_ID (hashp, i);
      }

  /* We have to register the composite character in cmpchar_table.  */
  if (n_cmpchars > (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK))
    /* No, we have no more room for a new composite character.  */
    return -1;

  /* Make the entry in hash table.  */
  if (hashp == NULL)
    {
      /* Make a table for 8 composite characters initially.  */
      hashp = (cmpchar_hash_table[hash_idx]
	       = (int *) xmalloc (sizeof (int) * (2 + 8)));
      CMPCHAR_HASH_SIZE (hashp) = 10;
      CMPCHAR_HASH_USED (hashp) = 2;
    }
  else if (CMPCHAR_HASH_USED (hashp) >= CMPCHAR_HASH_SIZE (hashp))
    {
      CMPCHAR_HASH_SIZE (hashp) += 8;
      hashp = (cmpchar_hash_table[hash_idx]
	       = (int *) xrealloc (hashp, 
				   sizeof (int) * CMPCHAR_HASH_SIZE (hashp)));
    }
  CMPCHAR_HASH_CMPCHAR_ID (hashp, CMPCHAR_HASH_USED (hashp)) = n_cmpchars;
  CMPCHAR_HASH_USED (hashp)++;

  /* Set information of the composite character in cmpchar_table.  */
  if (cmpchar_table_size == 0)
    {
      /* This is the first composite character to be registered.  */
      cmpchar_table_size = 256;
      cmpchar_table
	= (struct cmpchar_info **) xmalloc (sizeof (cmpchar_table[0])
					    * cmpchar_table_size);
    }
  else if (cmpchar_table_size <= n_cmpchars)
    {
      cmpchar_table_size += 256;
      cmpchar_table
	= (struct cmpchar_info **) xrealloc (cmpchar_table,
					     sizeof (cmpchar_table[0])
					     * cmpchar_table_size);
    }

  cmpcharp = (struct cmpchar_info *) xmalloc (sizeof (struct cmpchar_info));

  cmpcharp->len = len;
  cmpcharp->data = (unsigned char *) xmalloc (len + 1);
  bcopy (str, cmpcharp->data, len);
  cmpcharp->data[len] = 0;
  cmpcharp->glyph_len = chars;
  cmpcharp->glyph = (GLYPH *) xmalloc (sizeof (GLYPH) * chars);
  if (embedded_rule)
    {
      cmpcharp->cmp_rule = (unsigned char *) xmalloc (chars);
      cmpcharp->col_offset = (float *) xmalloc (sizeof (float) * chars);
    }
  else
    {
      cmpcharp->cmp_rule = NULL;
      cmpcharp->col_offset = NULL;
    }

  /* Setup GLYPH data and composition rules (if any) so as not to make
     them every time on displaying.  */
  {
    unsigned char *bufp;
    int width;
    float leftmost = 0.0, rightmost = 1.0;

    if (embedded_rule)
      /* At first, col_offset[N] is set to relative to col_offset[0].  */
      cmpcharp->col_offset[0] = 0;

    for (i = 0, bufp = cmpcharp->data + 1; i < chars; i++)
      {
	if (embedded_rule)
	  cmpcharp->cmp_rule[i] = *bufp++;

	if (*bufp == 0xA0)	/* This is an ASCII character.  */
	  {
	    cmpcharp->glyph[i] = FAST_MAKE_GLYPH ((*++bufp & 0x7F), 0);
	    width = 1;
	    bufp++;
	  }
	else			/* Multibyte character.  */
	  {
	    /* Make `bufp' point normal multi-byte form temporally.  */
	    *bufp -= 0x20;
	    cmpcharp->glyph[i]
	      = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp, 4, 0), 0);
	    width = WIDTH_BY_CHAR_HEAD (*bufp);
	    *bufp += 0x20;
	    bufp += BYTES_BY_CHAR_HEAD (*bufp - 0x20);
	  }

	if (embedded_rule && i > 0)
	  {
	    /* Reference points (global_ref and new_ref) are
	       encoded as below:
	       
	       0--1--2 -- ascent
	       |     |
	       |     |
	       |  4 -+--- center
	    -- 3     5 -- baseline
	       |     |
	       6--7--8 -- descent

	       Now, we calculate the column offset of the new glyph
	       from the left edge of the first glyph.  This can avoid
	       the same calculation everytime displaying this
	       composite character.  */

	    /* Reference points of global glyph and new glyph.  */
	    int global_ref = (cmpcharp->cmp_rule[i] - 0xA0) / 9;
	    int new_ref = (cmpcharp->cmp_rule[i] - 0xA0) % 9;
	    /* Column offset relative to the first glyph.  */
	    float left = (leftmost
			  + (global_ref % 3) * (rightmost - leftmost) / 2.0
			  - (new_ref % 3) * width / 2.0);

	    cmpcharp->col_offset[i] = left;
	    if (left < leftmost)
	      leftmost = left;
	    if (left + width > rightmost)
	      rightmost = left + width;
	  }
	else
	  {
	    if (width > rightmost)
	      rightmost = width;
	  }
      }
    if (embedded_rule)
      {
	/* Now col_offset[N] are relative to the left edge of the
           first component.  Make them relative to the left edge of
           overall glyph.  */
	for (i = 0; i < chars; i++)
	  cmpcharp->col_offset[i] -= leftmost;
	/* Make rightmost holds width of overall glyph.  */
	rightmost -= leftmost;
      }

    cmpcharp->width = rightmost;
    if (cmpcharp->width < rightmost)
      /* To get a ceiling integer value.  */
      cmpcharp->width++;
  }

  cmpchar_table[n_cmpchars] = cmpcharp;

  return n_cmpchars++;
}

/* Return the Nth element of the composite character C.  */
int
cmpchar_component (c, n)
     unsigned int c, n;
{
  int id = COMPOSITE_CHAR_ID (c);

  if (id >= n_cmpchars		/* C is not a valid composite character.  */
      || n >= cmpchar_table[id]->glyph_len) /* No such component.  */
    return -1;
  /* No face data is stored in glyph code.  */
  return ((int) (cmpchar_table[id]->glyph[n]));
}

DEFUN ("cmpcharp", Fcmpcharp, Scmpcharp, 1, 1, 0,
  "T if CHAR is a composite character.")
  (ch)
     Lisp_Object ch;
{
  CHECK_NUMBER (ch, 0);
  return (COMPOSITE_CHAR_P (XINT (ch)) ? Qt : Qnil);
}

DEFUN ("composite-char-component", Fcmpchar_component, Scmpchar_component,
       2, 2, 0,
  "Return the IDXth component character of composite character CHARACTER.")
  (character, idx)
     Lisp_Object character, idx;
{
  int c;

  CHECK_NUMBER (character, 0);
  CHECK_NUMBER (idx, 1);

  if ((c = cmpchar_component (XINT (character), XINT (idx))) < 0)
    args_out_of_range (character, idx);

  return make_number (c);
}

DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule, Scmpchar_cmp_rule,
       2, 2, 0,
  "Return the Nth composition rule embedded in composite character CHARACTER.\n\
The returned rule is for composing the Nth component\n\
on the (N-1)th component.  If N is 0, the returned value is always 255.")
  (character, n)
     Lisp_Object character, n;
{
  int id, i;

  CHECK_NUMBER (character, 0);
  CHECK_NUMBER (n, 1);

  id = COMPOSITE_CHAR_ID (XINT (character));
  if (id < 0 || id >= n_cmpchars)
    error ("Invalid composite character: %d", XINT (character));
  i = XINT (n);
  if (i > cmpchar_table[id]->glyph_len)
    args_out_of_range (character, n);

  return make_number (cmpchar_table[id]->cmp_rule[i]);
}

DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p,
       Scmpchar_cmp_rule_p, 1, 1, 0,
  "Return non-nil if composite character CHARACTER contains a embedded rule.")
  (character)
     Lisp_Object character;
{
  int id;

  CHECK_NUMBER (character, 0);
  id = COMPOSITE_CHAR_ID (XINT (character));
  if (id < 0 || id >= n_cmpchars)
    error ("Invalid composite character: %d", XINT (character));

  return (cmpchar_table[id]->cmp_rule ? Qt : Qnil);
}

DEFUN ("composite-char-component-count", Fcmpchar_cmp_count,
       Scmpchar_cmp_count, 1, 1, 0,
  "Return number of compoents of composite character CHARACTER.")
  (character)
     Lisp_Object character;
{
  int id;

  CHECK_NUMBER (character, 0);
  id = COMPOSITE_CHAR_ID (XINT (character));
  if (id < 0 || id >= n_cmpchars)
    error ("Invalid composite character: %d", XINT (character));

  return (make_number (cmpchar_table[id]->glyph_len));
}

DEFUN ("compose-string", Fcompose_string, Scompose_string,
       1, 1, 0,
  "Return one char string composed from all characters in STRING.")
  (str)
     Lisp_Object str;
{
  unsigned char buf[MAX_LENGTH_OF_MULTI_BYTE_FORM], *p, *pend, *ptemp;
  int len, i;

  CHECK_STRING (str, 0);

  buf[0] = LEADING_CODE_COMPOSITION;
  p = XSTRING (str)->data;
  pend = p + XSTRING (str)->size;
  i = 1;
  while (p < pend)
    {
      if (*p < 0x20 || *p == 127) /* control code */
	error ("Invalid component character: %d", *p);
      else if (*p < 0x80)	/* ASCII */
	{
	  if (i + 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
	    error ("Too long string to be composed: %s", XSTRING (str)->data);
	  /* Prepend an ASCII charset indicator 0xA0, set MSB of the
             code itself.  */
	  buf[i++] = 0xA0;
	  buf[i++] = *p++ + 0x80;
	}
      else if (*p == LEADING_CODE_COMPOSITION) /* composite char */
	{
	  /* Already composed.  Eliminate the heading
             LEADING_CODE_COMPOSITION, keep the remaining bytes
             unchanged.  */
	  p++;
	  ptemp = p;
	  while (! CHAR_HEAD_P (p)) p++;
	  if (i + (p - ptemp) >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
	    error ("Too long string to be composed: %s", XSTRING (str)->data);
	  bcopy (ptemp, buf + i, p - ptemp);
	  i += p - ptemp;
	}
      else			/* multibyte char */
	{
	  /* Add 0x20 to the base leading-code, keep the remaining
             bytes unchanged.  */
	  len = BYTES_BY_CHAR_HEAD (*p);
	  if (i + len >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
	    error ("Too long string to be composed: %s", XSTRING (str)->data);
	  bcopy (p, buf + i, len);
	  buf[i] += 0x20;
	  p += len, i += len;
	}
    }

  if (i < 5)
    /* STR contains only one character, which can't be composed.  */
    error ("Too short string to be composed: %s", XSTRING (str)->data);

  return make_string (buf, i);
}


charset_id_internal (charset_name)
     char *charset_name;
{
  Lisp_Object val = Fget (intern (charset_name), Qcharset);

  if (!VECTORP (val))
    error ("Charset %s is not defined", charset_name);

  return (XINT (XVECTOR (val)->contents[0]));
}

DEFUN ("setup-special-charsets", Fsetup_special_charsets,
       Ssetup_special_charsets, 0, 0, 0, "Internal use only.")
   ()
{
  charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
  charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
  charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
  charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
  charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
  charset_big5_1 = charset_id_internal ("chinese-big5-1");
  charset_big5_2 = charset_id_internal ("chinese-big5-2");
  return Qnil;
}

init_charset_once ()
{
  int i, j, k;

  staticpro (&Vcharset_table);
  staticpro (&Vcharset_symbol_table);

  /* This has to be done here, before we call Fmake_char_table.  */
  Qcharset_table = intern ("charset-table");
  staticpro (&Qcharset_table);

  /* Intern this now in case it isn't already done.
     Setting this variable twice is harmless.
     But don't staticpro it here--that is done in alloc.c.  */
  Qchar_table_extra_slots = intern ("char-table-extra-slots");

  /* Now we are ready to set up this property, so we can
     create the charset table.  */
  Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
  Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);

  Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1), Qnil);

  /* Setup tables.  */
  for (i = 0; i < 2; i++)
    for (j = 0; j < 2; j++)
      for (k = 0; k < 128; k++)
	iso_charset_table [i][j][k] = -1;

  bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
  cmpchar_table_size = n_cmpchars = 0;

  for (i = 0; i < 256; i++)
    BYTES_BY_CHAR_HEAD (i) = 1;
  BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 3;
  BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 3;
  BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 4;
  BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 4;
  /* The following doesn't reflect the actual bytes, but just to tell
     that it is a start of a multibyte character.  */
  BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION) = 2;

  for (i = 0; i < 128; i++)
    WIDTH_BY_CHAR_HEAD (i) = 1;
  for (; i < 256; i++)
    WIDTH_BY_CHAR_HEAD (i) = 4;
  WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 1;
  WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 2;
  WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 1;
  WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 2;
}

#ifdef emacs

syms_of_charset ()
{
  Qascii = intern ("ascii");
  staticpro (&Qascii);

  Qcharset = intern ("charset");
  staticpro (&Qcharset);

  /* Define ASCII charset now.  */
  update_charset_table (make_number (CHARSET_ASCII),
			make_number (1), make_number (94),
			make_number (1),
			make_number (0),
			make_number ('B'),
			make_number (0),
			build_string ("ASCII"),
			build_string ("ASCII"),
			build_string ("ASCII (ISO646 IRV)"));
  CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
  Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));

  Qcomposition = intern ("composition");
  staticpro (&Qcomposition);
  CHARSET_SYMBOL (CHARSET_COMPOSITION) = Qcomposition;

  defsubr (&Sdefine_charset);
  defsubr (&Sdeclare_equiv_charset);
  defsubr (&Sfind_charset_region);
  defsubr (&Sfind_charset_string);
  defsubr (&Smake_char_internal);
  defsubr (&Ssplit_char);
  defsubr (&Schar_charset);
  defsubr (&Siso_charset);
  defsubr (&Schar_bytes);
  defsubr (&Schar_width);
  defsubr (&Sstring_width);
  defsubr (&Schar_direction);
  defsubr (&Schars_in_string);
  defsubr (&Schars_in_region);
  defsubr (&Schar_boundary_p);
  defsubr (&Sconcat_chars);
  defsubr (&Scmpcharp);
  defsubr (&Scmpchar_component);
  defsubr (&Scmpchar_cmp_rule);
  defsubr (&Scmpchar_cmp_rule_p);
  defsubr (&Scmpchar_cmp_count);
  defsubr (&Scompose_string);
  defsubr (&Ssetup_special_charsets);

  DEFVAR_LISP ("charset-list", &Vcharset_list,
    "List of charsets ever defined.");
  Vcharset_list = Fcons (Qascii, Qnil);

  DEFVAR_INT ("leading-code-composition", &leading_code_composition,
    "Leading-code of composite characters.");
  leading_code_composition = LEADING_CODE_COMPOSITION;

  DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
    "Leading-code of private TYPE9N charset of column-width 1.");
  leading_code_private_11 = LEADING_CODE_PRIVATE_11;

  DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
    "Leading-code of private TYPE9N charset of column-width 2.");
  leading_code_private_12 = LEADING_CODE_PRIVATE_12;

  DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
    "Leading-code of private TYPE9Nx9N charset of column-width 1.");
  leading_code_private_21 = LEADING_CODE_PRIVATE_21;

  DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
    "Leading-code of private TYPE9Nx9N charset of column-width 2.");
  leading_code_private_22 = LEADING_CODE_PRIVATE_22;
}

#endif /* emacs */
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.