771
+ − 1 /* Code to handle Unicode conversion.
1267
+ − 2 Copyright (C) 2000, 2001, 2002, 2003 Ben Wing.
771
+ − 3
+ − 4 This file is part of XEmacs.
+ − 5
+ − 6 XEmacs is free software; you can redistribute it and/or modify it
+ − 7 under the terms of the GNU General Public License as published by the
+ − 8 Free Software Foundation; either version 2, or (at your option) any
+ − 9 later version.
+ − 10
+ − 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 14 for more details.
+ − 15
+ − 16 You should have received a copy of the GNU General Public License
+ − 17 along with XEmacs; see the file COPYING. If not, write to
+ − 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 19 Boston, MA 02111-1307, USA. */
+ − 20
+ − 21 /* Synched up with: FSF 20.3. Not in FSF. */
+ − 22
+ − 23 /* Authorship:
+ − 24
+ − 25 Current primary author: Ben Wing <ben@xemacs.org>
+ − 26
+ − 27 Written by Ben Wing <ben@xemacs.org>, June, 2001.
+ − 28 Separated out into this file, August, 2001.
+ − 29 Includes Unicode coding systems, some parts of which have been written
877
+ − 30 by someone else. #### Morioka and Hayashi, I think.
771
+ − 31
+ − 32 As of September 2001, the detection code is here and abstraction of the
877
+ − 33 detection system is finished. The unicode detectors have been rewritten
771
+ − 34 to include multiple levels of likelihood.
+ − 35 */
+ − 36
+ − 37 #include <config.h>
+ − 38 #include "lisp.h"
+ − 39
+ − 40 #include "charset.h"
+ − 41 #include "file-coding.h"
+ − 42 #include "opaque.h"
+ − 43
+ − 44 #include "sysfile.h"
+ − 45
+ − 46 /* #### WARNING! The current sledgehammer routines have a fundamental
+ − 47 problem in that they can't handle two characters mapping to a
+ − 48 single Unicode codepoint or vice-versa in a single charset table.
+ − 49 It's not clear there is any way to handle this and still make the
877
+ − 50 sledgehammer routines useful.
+ − 51
+ − 52 Inquiring Minds Want To Know Dept: does the above WARNING mean that
+ − 53 _if_ it happens, then it will signal error, or then it will do
+ − 54 something evil and unpredictable? Signaling an error is OK: for
+ − 55 all national standards, the national to Unicode map is an inclusion
+ − 56 (1-to-1). Any character set that does not behave that way is
+ − 57 broken according to the Unicode standard. */
+ − 58
771
+ − 59 /* #define SLEDGEHAMMER_CHECK_UNICODE */
+ − 60
+ − 61 /* We currently use the following format for tables:
+ − 62
+ − 63 If dimension == 1, to_unicode_table is a 96-element array of ints
+ − 64 (Unicode code points); else, it's a 96-element array of int *
+ − 65 pointers, each of which points to a 96-element array of ints. If no
+ − 66 elements in a row have been filled in, the pointer will point to a
+ − 67 default empty table; that way, memory usage is more reasonable but
+ − 68 lookup still fast.
+ − 69
+ − 70 -- If from_unicode_levels == 1, from_unicode_table is a 256-element
+ − 71 array of shorts (octet 1 in high byte, octet 2 in low byte; we don't
867
+ − 72 store Ichars directly to save space).
771
+ − 73
+ − 74 -- If from_unicode_levels == 2, from_unicode_table is a
+ − 75 256-element array of short * pointers, each of which points to a
+ − 76 256-element array of shorts.
+ − 77
+ − 78 -- If from_unicode_levels == 3, from_unicode_table is a
+ − 79 256-element array of short ** pointers, each of which points to
+ − 80 a 256-element array of short * pointers, each of which points to
+ − 81 a 256-element array of shorts.
+ − 82
+ − 83 -- If from_unicode_levels == 4, same thing but one level deeper.
+ − 84
+ − 85 Just as for to_unicode_table, we use default tables to fill in
+ − 86 all entries with no values in them.
+ − 87
+ − 88 #### An obvious space-saving optimization is to use variable-sized
+ − 89 tables, where each table instead of just being a 256-element array,
+ − 90 is a structure with a start value, an end value, and a variable
+ − 91 number of entries (END - START + 1). Only 8 bits are needed for
+ − 92 END and START, and could be stored at the end to avoid alignment
+ − 93 problems. However, before charging off and implementing this,
+ − 94 we need to consider whether it's worth it:
+ − 95
+ − 96 (1) Most tables will be highly localized in which code points are
+ − 97 defined, heavily reducing the possible memory waste. Before
+ − 98 doing any rewriting, write some code to see how much memory is
+ − 99 actually being wasted (i.e. ratio of empty entries to total # of
+ − 100 entries) and only start rewriting if it's unacceptably high. You
+ − 101 have to check over all charsets.
+ − 102
+ − 103 (2) Since entries are usually added one at a time, you have to be
+ − 104 very careful when creating the tables to avoid realloc()/free()
+ − 105 thrashing in the common case when you are in an area of high
+ − 106 localization and are going to end up using most entries in the
+ − 107 table. You'd certainly want to allow only certain sizes, not
+ − 108 arbitrary ones (probably powers of 2, where you want the entire
+ − 109 block including the START/END values to fit into a power of 2,
+ − 110 minus any malloc overhead if there is any -- there's none under
+ − 111 gmalloc.c, and probably most system malloc() functions are quite
+ − 112 smart nowadays and also have no overhead). You could optimize
+ − 113 somewhat during the in-C initializations, because you can compute
+ − 114 the actual usage of various tables by scanning the entries you're
+ − 115 going to add in a separate pass before adding them. (You could
+ − 116 actually do the same thing when entries are added on the Lisp
+ − 117 level by making the assumption that all the entries will come in
+ − 118 one after another before any use is made of the data. So as
+ − 119 they're coming in, you just store them in a big long list, and
+ − 120 the first time you need to retrieve an entry, you compute the
+ − 121 whole table at once.) You'd still have to deal with the
+ − 122 possibility of later entries coming in, though.
+ − 123
+ − 124 (3) You do lose some speed using START/END values, since you need
+ − 125 a couple of comparisons at each level. This could easily make
+ − 126 each single lookup become 3-4 times slower. The Unicode book
+ − 127 considers this a big issue, and recommends against variable-sized
+ − 128 tables for this reason; however, they almost certainly have in
+ − 129 mind applications that primarily involve conversion of large
+ − 130 amounts of data. Most Unicode strings that are translated in
+ − 131 XEmacs are fairly small. The only place where this might matter
+ − 132 is in loading large files -- e.g. a 3-megabyte Unicode-encoded
+ − 133 file. So think about this, and maybe do a trial implementation
+ − 134 where you don't worry too much about the intricacies of (2) and
+ − 135 just implement some basic "multiply by 1.5" trick or something to
+ − 136 do the resizing. There is a very good FAQ on Unicode called
+ − 137 something like the Linux-Unicode How-To (it should be part of the
+ − 138 Linux How-To's, I think), that lists the url of a guy with a
+ − 139 whole bunch of unicode files you can use to stress-test your
+ − 140 implementations, and he's highly likely to have a good
+ − 141 multi-megabyte Unicode-encoded file (with normal text in it -- if
+ − 142 you created your own just by creating repeated strings of letters
+ − 143 and numbers, you probably wouldn't get accurate results).
+ − 144 */
+ − 145
+ − 146 /* When MULE is not defined, we may still need some Unicode support --
+ − 147 in particular, some Windows API's always want Unicode, and the way
+ − 148 we've set up the Unicode encapsulation, we may as well go ahead and
+ − 149 always use the Unicode versions of split API's. (It would be
+ − 150 trickier to not use them, and pointless -- under NT, the ANSI API's
+ − 151 call the Unicode ones anyway, so in the case of structures, we'd be
+ − 152 converting from Unicode to ANSI structures, only to have the OS
+ − 153 convert them back.) */
+ − 154
+ − 155 Lisp_Object Qunicode;
+ − 156 Lisp_Object Qutf_16, Qutf_8, Qucs_4, Qutf_7;
+ − 157 Lisp_Object Qneed_bom;
+ − 158
+ − 159 Lisp_Object Qutf_16_little_endian, Qutf_16_bom;
+ − 160 Lisp_Object Qutf_16_little_endian_bom;
+ − 161
985
+ − 162 Lisp_Object Qutf_8_bom;
+ − 163
771
+ − 164 #ifdef MULE
+ − 165
877
+ − 166 /* #### Using ints for to_unicode is OK (as long as they are >= 32 bits).
+ − 167 However, shouldn't the shorts below be unsigned? */
771
+ − 168 static int *to_unicode_blank_1;
+ − 169 static int **to_unicode_blank_2;
+ − 170
+ − 171 static short *from_unicode_blank_1;
+ − 172 static short **from_unicode_blank_2;
+ − 173 static short ***from_unicode_blank_3;
+ − 174 static short ****from_unicode_blank_4;
+ − 175
1204
+ − 176 static const struct memory_description to_unicode_level_0_desc_1[] = {
771
+ − 177 { XD_END }
+ − 178 };
+ − 179
1204
+ − 180 static const struct sized_memory_description to_unicode_level_0_desc = {
+ − 181 sizeof (int), to_unicode_level_0_desc_1
771
+ − 182 };
+ − 183
1204
+ − 184 static const struct memory_description to_unicode_level_1_desc_1[] = {
+ − 185 { XD_STRUCT_PTR, 0, 96, &to_unicode_level_0_desc },
771
+ − 186 { XD_END }
+ − 187 };
+ − 188
1204
+ − 189 static const struct sized_memory_description to_unicode_level_1_desc = {
+ − 190 sizeof (void *), to_unicode_level_1_desc_1
771
+ − 191 };
+ − 192
1204
+ − 193 static const struct memory_description to_unicode_description_1[] = {
+ − 194 { XD_STRUCT_PTR, 1, 96, &to_unicode_level_0_desc },
+ − 195 { XD_STRUCT_PTR, 2, 96, &to_unicode_level_1_desc },
771
+ − 196 { XD_END }
+ − 197 };
+ − 198
+ − 199 /* Not static because each charset has a set of to and from tables and
+ − 200 needs to describe them to pdump. */
1204
+ − 201 const struct sized_memory_description to_unicode_description = {
+ − 202 sizeof (void *), to_unicode_description_1
+ − 203 };
+ − 204
+ − 205 static const struct memory_description from_unicode_level_0_desc_1[] = {
771
+ − 206 { XD_END }
+ − 207 };
+ − 208
1204
+ − 209 static const struct sized_memory_description from_unicode_level_0_desc = {
+ − 210 sizeof (short), from_unicode_level_0_desc_1
771
+ − 211 };
+ − 212
1204
+ − 213 static const struct memory_description from_unicode_level_1_desc_1[] = {
+ − 214 { XD_STRUCT_PTR, 0, 256, &from_unicode_level_0_desc },
771
+ − 215 { XD_END }
+ − 216 };
+ − 217
1204
+ − 218 static const struct sized_memory_description from_unicode_level_1_desc = {
+ − 219 sizeof (void *), from_unicode_level_1_desc_1
771
+ − 220 };
+ − 221
1204
+ − 222 static const struct memory_description from_unicode_level_2_desc_1[] = {
+ − 223 { XD_STRUCT_PTR, 0, 256, &from_unicode_level_1_desc },
771
+ − 224 { XD_END }
+ − 225 };
+ − 226
1204
+ − 227 static const struct sized_memory_description from_unicode_level_2_desc = {
+ − 228 sizeof (void *), from_unicode_level_2_desc_1
771
+ − 229 };
+ − 230
1204
+ − 231 static const struct memory_description from_unicode_level_3_desc_1[] = {
+ − 232 { XD_STRUCT_PTR, 0, 256, &from_unicode_level_2_desc },
771
+ − 233 { XD_END }
+ − 234 };
+ − 235
1204
+ − 236 static const struct sized_memory_description from_unicode_level_3_desc = {
+ − 237 sizeof (void *), from_unicode_level_3_desc_1
771
+ − 238 };
+ − 239
1204
+ − 240 static const struct memory_description from_unicode_description_1[] = {
+ − 241 { XD_STRUCT_PTR, 1, 256, &from_unicode_level_0_desc },
+ − 242 { XD_STRUCT_PTR, 2, 256, &from_unicode_level_1_desc },
+ − 243 { XD_STRUCT_PTR, 3, 256, &from_unicode_level_2_desc },
+ − 244 { XD_STRUCT_PTR, 4, 256, &from_unicode_level_3_desc },
771
+ − 245 { XD_END }
+ − 246 };
+ − 247
+ − 248 /* Not static because each charset has a set of to and from tables and
+ − 249 needs to describe them to pdump. */
1204
+ − 250 const struct sized_memory_description from_unicode_description = {
+ − 251 sizeof (void *), from_unicode_description_1
771
+ − 252 };
+ − 253
+ − 254 static Lisp_Object_dynarr *unicode_precedence_dynarr;
+ − 255
1204
+ − 256 static const struct memory_description lod_description_1[] = {
+ − 257 XD_DYNARR_DESC (Lisp_Object_dynarr, &lisp_object_description),
771
+ − 258 { XD_END }
+ − 259 };
+ − 260
1204
+ − 261 static const struct sized_memory_description lisp_object_dynarr_description = {
771
+ − 262 sizeof (Lisp_Object_dynarr),
+ − 263 lod_description_1
+ − 264 };
+ − 265
+ − 266 Lisp_Object Vlanguage_unicode_precedence_list;
+ − 267 Lisp_Object Vdefault_unicode_precedence_list;
+ − 268
+ − 269 Lisp_Object Qignore_first_column;
+ − 270
+ − 271
+ − 272 /************************************************************************/
+ − 273 /* Unicode implementation */
+ − 274 /************************************************************************/
+ − 275
+ − 276 #define BREAKUP_UNICODE_CODE(val, u1, u2, u3, u4, levels) \
+ − 277 do { \
+ − 278 int buc_val = (val); \
+ − 279 \
+ − 280 (u1) = buc_val >> 24; \
+ − 281 (u2) = (buc_val >> 16) & 255; \
+ − 282 (u3) = (buc_val >> 8) & 255; \
+ − 283 (u4) = buc_val & 255; \
+ − 284 (levels) = (buc_val <= 0xFF ? 1 : \
+ − 285 buc_val <= 0xFFFF ? 2 : \
+ − 286 buc_val <= 0xFFFFFF ? 3 : \
+ − 287 4); \
+ − 288 } while (0)
+ − 289
+ − 290 static void
+ − 291 init_blank_unicode_tables (void)
+ − 292 {
+ − 293 int i;
+ − 294
+ − 295 from_unicode_blank_1 = xnew_array (short, 256);
+ − 296 from_unicode_blank_2 = xnew_array (short *, 256);
+ − 297 from_unicode_blank_3 = xnew_array (short **, 256);
+ − 298 from_unicode_blank_4 = xnew_array (short ***, 256);
+ − 299 for (i = 0; i < 256; i++)
+ − 300 {
877
+ − 301 /* #### IMWTK: Why does using -1 here work? Simply because there are
+ − 302 no existing 96x96 charsets? */
771
+ − 303 from_unicode_blank_1[i] = (short) -1;
+ − 304 from_unicode_blank_2[i] = from_unicode_blank_1;
+ − 305 from_unicode_blank_3[i] = from_unicode_blank_2;
+ − 306 from_unicode_blank_4[i] = from_unicode_blank_3;
+ − 307 }
+ − 308
+ − 309 to_unicode_blank_1 = xnew_array (int, 96);
+ − 310 to_unicode_blank_2 = xnew_array (int *, 96);
+ − 311 for (i = 0; i < 96; i++)
+ − 312 {
877
+ − 313 /* Here -1 is guaranteed OK. */
771
+ − 314 to_unicode_blank_1[i] = -1;
+ − 315 to_unicode_blank_2[i] = to_unicode_blank_1;
+ − 316 }
+ − 317 }
+ − 318
+ − 319 static void *
+ − 320 create_new_from_unicode_table (int level)
+ − 321 {
+ − 322 switch (level)
+ − 323 {
+ − 324 /* WARNING: If you are thinking of compressing these, keep in
+ − 325 mind that sizeof (short) does not equal sizeof (short *). */
+ − 326 case 1:
+ − 327 {
+ − 328 short *newtab = xnew_array (short, 256);
+ − 329 memcpy (newtab, from_unicode_blank_1, 256 * sizeof (short));
+ − 330 return newtab;
+ − 331 }
+ − 332 case 2:
+ − 333 {
+ − 334 short **newtab = xnew_array (short *, 256);
+ − 335 memcpy (newtab, from_unicode_blank_2, 256 * sizeof (short *));
+ − 336 return newtab;
+ − 337 }
+ − 338 case 3:
+ − 339 {
+ − 340 short ***newtab = xnew_array (short **, 256);
+ − 341 memcpy (newtab, from_unicode_blank_3, 256 * sizeof (short **));
+ − 342 return newtab;
+ − 343 }
+ − 344 case 4:
+ − 345 {
+ − 346 short ****newtab = xnew_array (short ***, 256);
+ − 347 memcpy (newtab, from_unicode_blank_4, 256 * sizeof (short ***));
+ − 348 return newtab;
+ − 349 }
+ − 350 default:
+ − 351 abort ();
+ − 352 return 0;
+ − 353 }
+ − 354 }
+ − 355
877
+ − 356 /* Allocate and blank the tables.
+ − 357 Loading them up is done by parse-unicode-translation-table. */
771
+ − 358 void
+ − 359 init_charset_unicode_tables (Lisp_Object charset)
+ − 360 {
+ − 361 if (XCHARSET_DIMENSION (charset) == 1)
+ − 362 {
+ − 363 int *to_table = xnew_array (int, 96);
+ − 364 memcpy (to_table, to_unicode_blank_1, 96 * sizeof (int));
+ − 365 XCHARSET_TO_UNICODE_TABLE (charset) = to_table;
+ − 366 }
+ − 367 else
+ − 368 {
+ − 369 int **to_table = xnew_array (int *, 96);
+ − 370 memcpy (to_table, to_unicode_blank_2, 96 * sizeof (int *));
+ − 371 XCHARSET_TO_UNICODE_TABLE (charset) = to_table;
+ − 372 }
+ − 373
+ − 374 {
+ − 375 XCHARSET_FROM_UNICODE_TABLE (charset) = create_new_from_unicode_table (1);
+ − 376 XCHARSET_FROM_UNICODE_LEVELS (charset) = 1;
+ − 377 }
+ − 378 }
+ − 379
+ − 380 static void
+ − 381 free_from_unicode_table (void *table, int level)
+ − 382 {
+ − 383 int i;
+ − 384
+ − 385 switch (level)
+ − 386 {
+ − 387 case 2:
+ − 388 {
+ − 389 short **tab = (short **) table;
+ − 390 for (i = 0; i < 256; i++)
+ − 391 {
+ − 392 if (tab[i] != from_unicode_blank_1)
+ − 393 free_from_unicode_table (tab[i], 1);
+ − 394 }
+ − 395 break;
+ − 396 }
+ − 397 case 3:
+ − 398 {
+ − 399 short ***tab = (short ***) table;
+ − 400 for (i = 0; i < 256; i++)
+ − 401 {
+ − 402 if (tab[i] != from_unicode_blank_2)
+ − 403 free_from_unicode_table (tab[i], 2);
+ − 404 }
+ − 405 break;
+ − 406 }
+ − 407 case 4:
+ − 408 {
+ − 409 short ****tab = (short ****) table;
+ − 410 for (i = 0; i < 256; i++)
+ − 411 {
+ − 412 if (tab[i] != from_unicode_blank_3)
+ − 413 free_from_unicode_table (tab[i], 3);
+ − 414 }
+ − 415 break;
+ − 416 }
+ − 417 }
+ − 418
+ − 419 xfree (table);
+ − 420 }
+ − 421
+ − 422 static void
+ − 423 free_to_unicode_table (void *table, int level)
+ − 424 {
+ − 425 if (level == 2)
+ − 426 {
+ − 427 int i;
+ − 428 int **tab = (int **) table;
+ − 429
+ − 430 for (i = 0; i < 96; i++)
+ − 431 {
+ − 432 if (tab[i] != to_unicode_blank_1)
+ − 433 free_to_unicode_table (tab[i], 1);
+ − 434 }
+ − 435 }
+ − 436
+ − 437 xfree (table);
+ − 438 }
+ − 439
+ − 440 void
+ − 441 free_charset_unicode_tables (Lisp_Object charset)
+ − 442 {
+ − 443 free_to_unicode_table (XCHARSET_TO_UNICODE_TABLE (charset),
+ − 444 XCHARSET_DIMENSION (charset));
+ − 445 free_from_unicode_table (XCHARSET_FROM_UNICODE_TABLE (charset),
+ − 446 XCHARSET_FROM_UNICODE_LEVELS (charset));
+ − 447 }
+ − 448
+ − 449 #ifdef MEMORY_USAGE_STATS
+ − 450
+ − 451 static Bytecount
+ − 452 compute_from_unicode_table_size_1 (void *table, int level,
+ − 453 struct overhead_stats *stats)
+ − 454 {
+ − 455 int i;
+ − 456 Bytecount size = 0;
+ − 457
+ − 458 switch (level)
+ − 459 {
+ − 460 case 2:
+ − 461 {
+ − 462 short **tab = (short **) table;
+ − 463 for (i = 0; i < 256; i++)
+ − 464 {
+ − 465 if (tab[i] != from_unicode_blank_1)
+ − 466 size += compute_from_unicode_table_size_1 (tab[i], 1, stats);
+ − 467 }
+ − 468 break;
+ − 469 }
+ − 470 case 3:
+ − 471 {
+ − 472 short ***tab = (short ***) table;
+ − 473 for (i = 0; i < 256; i++)
+ − 474 {
+ − 475 if (tab[i] != from_unicode_blank_2)
+ − 476 size += compute_from_unicode_table_size_1 (tab[i], 2, stats);
+ − 477 }
+ − 478 break;
+ − 479 }
+ − 480 case 4:
+ − 481 {
+ − 482 short ****tab = (short ****) table;
+ − 483 for (i = 0; i < 256; i++)
+ − 484 {
+ − 485 if (tab[i] != from_unicode_blank_3)
+ − 486 size += compute_from_unicode_table_size_1 (tab[i], 3, stats);
+ − 487 }
+ − 488 break;
+ − 489 }
+ − 490 }
+ − 491
+ − 492 size += malloced_storage_size (table,
+ − 493 256 * (level == 1 ? sizeof (short) :
+ − 494 sizeof (void *)),
+ − 495 stats);
+ − 496 return size;
+ − 497 }
+ − 498
+ − 499 static Bytecount
+ − 500 compute_to_unicode_table_size_1 (void *table, int level,
+ − 501 struct overhead_stats *stats)
+ − 502 {
+ − 503 Bytecount size = 0;
+ − 504
+ − 505 if (level == 2)
+ − 506 {
+ − 507 int i;
+ − 508 int **tab = (int **) table;
+ − 509
+ − 510 for (i = 0; i < 96; i++)
+ − 511 {
+ − 512 if (tab[i] != to_unicode_blank_1)
+ − 513 size += compute_to_unicode_table_size_1 (tab[i], 1, stats);
+ − 514 }
+ − 515 }
+ − 516
+ − 517 size += malloced_storage_size (table,
+ − 518 96 * (level == 1 ? sizeof (int) :
+ − 519 sizeof (void *)),
+ − 520 stats);
+ − 521 return size;
+ − 522 }
+ − 523
+ − 524 Bytecount
+ − 525 compute_from_unicode_table_size (Lisp_Object charset,
+ − 526 struct overhead_stats *stats)
+ − 527 {
+ − 528 return (compute_from_unicode_table_size_1
+ − 529 (XCHARSET_FROM_UNICODE_TABLE (charset),
+ − 530 XCHARSET_FROM_UNICODE_LEVELS (charset),
+ − 531 stats));
+ − 532 }
+ − 533
+ − 534 Bytecount
+ − 535 compute_to_unicode_table_size (Lisp_Object charset,
+ − 536 struct overhead_stats *stats)
+ − 537 {
+ − 538 return (compute_to_unicode_table_size_1
+ − 539 (XCHARSET_TO_UNICODE_TABLE (charset),
+ − 540 XCHARSET_DIMENSION (charset),
+ − 541 stats));
+ − 542 }
+ − 543
+ − 544 #endif
+ − 545
+ − 546 #ifdef SLEDGEHAMMER_CHECK_UNICODE
+ − 547
+ − 548 /* "Sledgehammer checks" are checks that verify the self-consistency
+ − 549 of an entire structure every time a change is about to be made or
+ − 550 has been made to the structure. Not fast but a pretty much
+ − 551 sure-fire way of flushing out any incorrectnesses in the algorithms
+ − 552 that create the structure.
+ − 553
+ − 554 Checking only after a change has been made will speed things up by
+ − 555 a factor of 2, but it doesn't absolutely prove that the code just
+ − 556 checked caused the problem; perhaps it happened elsewhere, either
+ − 557 in some code you forgot to sledgehammer check or as a result of
+ − 558 data corruption. */
+ − 559
+ − 560 static void
+ − 561 assert_not_any_blank_table (void *tab)
+ − 562 {
+ − 563 assert (tab != from_unicode_blank_1);
+ − 564 assert (tab != from_unicode_blank_2);
+ − 565 assert (tab != from_unicode_blank_3);
+ − 566 assert (tab != from_unicode_blank_4);
+ − 567 assert (tab != to_unicode_blank_1);
+ − 568 assert (tab != to_unicode_blank_2);
+ − 569 assert (tab);
+ − 570 }
+ − 571
+ − 572 static void
+ − 573 sledgehammer_check_from_table (Lisp_Object charset, void *table, int level,
+ − 574 int codetop)
+ − 575 {
+ − 576 int i;
+ − 577
+ − 578 switch (level)
+ − 579 {
+ − 580 case 1:
+ − 581 {
+ − 582 short *tab = (short *) table;
+ − 583 for (i = 0; i < 256; i++)
+ − 584 {
+ − 585 if (tab[i] != -1)
+ − 586 {
+ − 587 Lisp_Object char_charset;
+ − 588 int c1, c2;
+ − 589
867
+ − 590 assert (valid_ichar_p (tab[i]));
+ − 591 BREAKUP_ICHAR (tab[i], char_charset, c1, c2);
771
+ − 592 assert (EQ (charset, char_charset));
+ − 593 if (XCHARSET_DIMENSION (charset) == 1)
+ − 594 {
+ − 595 int *to_table =
+ − 596 (int *) XCHARSET_TO_UNICODE_TABLE (charset);
+ − 597 assert_not_any_blank_table (to_table);
+ − 598 assert (to_table[c1 - 32] == (codetop << 8) + i);
+ − 599 }
+ − 600 else
+ − 601 {
+ − 602 int **to_table =
+ − 603 (int **) XCHARSET_TO_UNICODE_TABLE (charset);
+ − 604 assert_not_any_blank_table (to_table);
+ − 605 assert_not_any_blank_table (to_table[c1 - 32]);
+ − 606 assert (to_table[c1 - 32][c2 - 32] == (codetop << 8) + i);
+ − 607 }
+ − 608 }
+ − 609 }
+ − 610 break;
+ − 611 }
+ − 612 case 2:
+ − 613 {
+ − 614 short **tab = (short **) table;
+ − 615 for (i = 0; i < 256; i++)
+ − 616 {
+ − 617 if (tab[i] != from_unicode_blank_1)
+ − 618 sledgehammer_check_from_table (charset, tab[i], 1,
+ − 619 (codetop << 8) + i);
+ − 620 }
+ − 621 break;
+ − 622 }
+ − 623 case 3:
+ − 624 {
+ − 625 short ***tab = (short ***) table;
+ − 626 for (i = 0; i < 256; i++)
+ − 627 {
+ − 628 if (tab[i] != from_unicode_blank_2)
+ − 629 sledgehammer_check_from_table (charset, tab[i], 2,
+ − 630 (codetop << 8) + i);
+ − 631 }
+ − 632 break;
+ − 633 }
+ − 634 case 4:
+ − 635 {
+ − 636 short ****tab = (short ****) table;
+ − 637 for (i = 0; i < 256; i++)
+ − 638 {
+ − 639 if (tab[i] != from_unicode_blank_3)
+ − 640 sledgehammer_check_from_table (charset, tab[i], 3,
+ − 641 (codetop << 8) + i);
+ − 642 }
+ − 643 break;
+ − 644 }
+ − 645 default:
+ − 646 abort ();
+ − 647 }
+ − 648 }
+ − 649
+ − 650 static void
+ − 651 sledgehammer_check_to_table (Lisp_Object charset, void *table, int level,
+ − 652 int codetop)
+ − 653 {
+ − 654 int i;
+ − 655
+ − 656 switch (level)
+ − 657 {
+ − 658 case 1:
+ − 659 {
+ − 660 int *tab = (int *) table;
+ − 661
+ − 662 if (XCHARSET_CHARS (charset) == 94)
+ − 663 {
+ − 664 assert (tab[0] == -1);
+ − 665 assert (tab[95] == -1);
+ − 666 }
+ − 667
+ − 668 for (i = 0; i < 96; i++)
+ − 669 {
+ − 670 if (tab[i] != -1)
+ − 671 {
+ − 672 int u4, u3, u2, u1, levels;
867
+ − 673 Ichar ch;
+ − 674 Ichar this_ch;
771
+ − 675 short val;
+ − 676 void *frtab = XCHARSET_FROM_UNICODE_TABLE (charset);
+ − 677
+ − 678 if (XCHARSET_DIMENSION (charset) == 1)
867
+ − 679 this_ch = make_ichar (charset, i + 32, 0);
771
+ − 680 else
867
+ − 681 this_ch = make_ichar (charset, codetop + 32, i + 32);
771
+ − 682
+ − 683 assert (tab[i] >= 0);
+ − 684 BREAKUP_UNICODE_CODE (tab[i], u4, u3, u2, u1, levels);
+ − 685 assert (levels <= XCHARSET_FROM_UNICODE_LEVELS (charset));
+ − 686
+ − 687 switch (XCHARSET_FROM_UNICODE_LEVELS (charset))
+ − 688 {
+ − 689 case 1: val = ((short *) frtab)[u1]; break;
+ − 690 case 2: val = ((short **) frtab)[u2][u1]; break;
+ − 691 case 3: val = ((short ***) frtab)[u3][u2][u1]; break;
+ − 692 case 4: val = ((short ****) frtab)[u4][u3][u2][u1]; break;
+ − 693 default: abort ();
+ − 694 }
+ − 695
867
+ − 696 ch = make_ichar (charset, val >> 8, val & 0xFF);
771
+ − 697 assert (ch == this_ch);
+ − 698
+ − 699 switch (XCHARSET_FROM_UNICODE_LEVELS (charset))
+ − 700 {
+ − 701 case 4:
+ − 702 assert_not_any_blank_table (frtab);
+ − 703 frtab = ((short ****) frtab)[u4];
+ − 704 /* fall through */
+ − 705 case 3:
+ − 706 assert_not_any_blank_table (frtab);
+ − 707 frtab = ((short ***) frtab)[u3];
+ − 708 /* fall through */
+ − 709 case 2:
+ − 710 assert_not_any_blank_table (frtab);
+ − 711 frtab = ((short **) frtab)[u2];
+ − 712 /* fall through */
+ − 713 case 1:
+ − 714 assert_not_any_blank_table (frtab);
+ − 715 break;
+ − 716 default: abort ();
+ − 717 }
+ − 718 }
+ − 719 }
+ − 720 break;
+ − 721 }
+ − 722 case 2:
+ − 723 {
+ − 724 int **tab = (int **) table;
+ − 725
+ − 726 if (XCHARSET_CHARS (charset) == 94)
+ − 727 {
+ − 728 assert (tab[0] == to_unicode_blank_1);
+ − 729 assert (tab[95] == to_unicode_blank_1);
+ − 730 }
+ − 731
+ − 732 for (i = 0; i < 96; i++)
+ − 733 {
+ − 734 if (tab[i] != to_unicode_blank_1)
+ − 735 sledgehammer_check_to_table (charset, tab[i], 1, i);
+ − 736 }
+ − 737 break;
+ − 738 }
+ − 739 default:
+ − 740 abort ();
+ − 741 }
+ − 742 }
+ − 743
+ − 744 static void
+ − 745 sledgehammer_check_unicode_tables (Lisp_Object charset)
+ − 746 {
+ − 747 /* verify that the blank tables have not been modified */
+ − 748 int i;
+ − 749 int from_level = XCHARSET_FROM_UNICODE_LEVELS (charset);
+ − 750 int to_level = XCHARSET_FROM_UNICODE_LEVELS (charset);
+ − 751
+ − 752 for (i = 0; i < 256; i++)
+ − 753 {
+ − 754 assert (from_unicode_blank_1[i] == (short) -1);
+ − 755 assert (from_unicode_blank_2[i] == from_unicode_blank_1);
+ − 756 assert (from_unicode_blank_3[i] == from_unicode_blank_2);
+ − 757 assert (from_unicode_blank_4[i] == from_unicode_blank_3);
+ − 758 }
+ − 759
+ − 760 for (i = 0; i < 96; i++)
+ − 761 {
+ − 762 assert (to_unicode_blank_1[i] == -1);
+ − 763 assert (to_unicode_blank_2[i] == to_unicode_blank_1);
+ − 764 }
+ − 765
+ − 766 assert (from_level >= 1 && from_level <= 4);
+ − 767
+ − 768 sledgehammer_check_from_table (charset,
+ − 769 XCHARSET_FROM_UNICODE_TABLE (charset),
+ − 770 from_level, 0);
+ − 771
+ − 772 sledgehammer_check_to_table (charset,
+ − 773 XCHARSET_TO_UNICODE_TABLE (charset),
+ − 774 XCHARSET_DIMENSION (charset), 0);
+ − 775 }
+ − 776
+ − 777 #endif /* SLEDGEHAMMER_CHECK_UNICODE */
+ − 778
+ − 779 static void
867
+ − 780 set_unicode_conversion (Ichar chr, int code)
771
+ − 781 {
+ − 782 Lisp_Object charset;
+ − 783 int c1, c2;
+ − 784
867
+ − 785 BREAKUP_ICHAR (chr, charset, c1, c2);
771
+ − 786
877
+ − 787 /* I tried an assert on code > 255 || chr == code, but that fails because
+ − 788 Mule gives many Latin characters separate code points for different
+ − 789 ISO 8859 coded character sets. Obvious in hindsight.... */
+ − 790 assert (!EQ (charset, Vcharset_ascii) || chr == code);
+ − 791 assert (!EQ (charset, Vcharset_latin_iso8859_1) || chr == code);
+ − 792 assert (!EQ (charset, Vcharset_control_1) || chr == code);
+ − 793
+ − 794 /* This assert is needed because it is simply unimplemented. */
771
+ − 795 assert (!EQ (charset, Vcharset_composite));
+ − 796
+ − 797 #ifdef SLEDGEHAMMER_CHECK_UNICODE
+ − 798 sledgehammer_check_unicode_tables (charset);
+ − 799 #endif
+ − 800
+ − 801 /* First, the char -> unicode translation */
+ − 802
+ − 803 if (XCHARSET_DIMENSION (charset) == 1)
+ − 804 {
+ − 805 int *to_table = (int *) XCHARSET_TO_UNICODE_TABLE (charset);
+ − 806 to_table[c1 - 32] = code;
+ − 807 }
+ − 808 else
+ − 809 {
+ − 810 int **to_table_2 = (int **) XCHARSET_TO_UNICODE_TABLE (charset);
+ − 811 int *to_table_1;
+ − 812
+ − 813 assert (XCHARSET_DIMENSION (charset) == 2);
+ − 814 to_table_1 = to_table_2[c1 - 32];
+ − 815 if (to_table_1 == to_unicode_blank_1)
+ − 816 {
+ − 817 to_table_1 = xnew_array (int, 96);
+ − 818 memcpy (to_table_1, to_unicode_blank_1, 96 * sizeof (int));
+ − 819 to_table_2[c1 - 32] = to_table_1;
+ − 820 }
+ − 821 to_table_1[c2 - 32] = code;
+ − 822 }
+ − 823
+ − 824 /* Then, unicode -> char: much harder */
+ − 825
+ − 826 {
+ − 827 int charset_levels;
+ − 828 int u4, u3, u2, u1;
+ − 829 int code_levels;
+ − 830 BREAKUP_UNICODE_CODE (code, u4, u3, u2, u1, code_levels);
+ − 831
+ − 832 charset_levels = XCHARSET_FROM_UNICODE_LEVELS (charset);
+ − 833
+ − 834 /* Make sure the charset's tables have at least as many levels as
+ − 835 the code point has: Note that the charset is guaranteed to have
+ − 836 at least one level, because it was created that way */
+ − 837 if (charset_levels < code_levels)
+ − 838 {
+ − 839 int i;
+ − 840
+ − 841 assert (charset_levels > 0);
+ − 842 for (i = 2; i <= code_levels; i++)
+ − 843 {
+ − 844 if (charset_levels < i)
+ − 845 {
+ − 846 void *old_table = XCHARSET_FROM_UNICODE_TABLE (charset);
+ − 847 void *table = create_new_from_unicode_table (i);
+ − 848 XCHARSET_FROM_UNICODE_TABLE (charset) = table;
+ − 849
+ − 850 switch (i)
+ − 851 {
+ − 852 case 2:
+ − 853 ((short **) table)[0] = (short *) old_table;
+ − 854 break;
+ − 855 case 3:
+ − 856 ((short ***) table)[0] = (short **) old_table;
+ − 857 break;
+ − 858 case 4:
+ − 859 ((short ****) table)[0] = (short ***) old_table;
+ − 860 break;
+ − 861 default: abort ();
+ − 862 }
+ − 863 }
+ − 864 }
+ − 865
+ − 866 charset_levels = code_levels;
+ − 867 XCHARSET_FROM_UNICODE_LEVELS (charset) = code_levels;
+ − 868 }
+ − 869
+ − 870 /* Now, make sure there is a non-default table at each level */
+ − 871 {
+ − 872 int i;
+ − 873 void *table = XCHARSET_FROM_UNICODE_TABLE (charset);
+ − 874
+ − 875 for (i = charset_levels; i >= 2; i--)
+ − 876 {
+ − 877 switch (i)
+ − 878 {
+ − 879 case 4:
+ − 880 if (((short ****) table)[u4] == from_unicode_blank_3)
+ − 881 ((short ****) table)[u4] =
+ − 882 ((short ***) create_new_from_unicode_table (3));
+ − 883 table = ((short ****) table)[u4];
+ − 884 break;
+ − 885 case 3:
+ − 886 if (((short ***) table)[u3] == from_unicode_blank_2)
+ − 887 ((short ***) table)[u3] =
+ − 888 ((short **) create_new_from_unicode_table (2));
+ − 889 table = ((short ***) table)[u3];
+ − 890 break;
+ − 891 case 2:
+ − 892 if (((short **) table)[u2] == from_unicode_blank_1)
+ − 893 ((short **) table)[u2] =
+ − 894 ((short *) create_new_from_unicode_table (1));
+ − 895 table = ((short **) table)[u2];
+ − 896 break;
+ − 897 default: abort ();
+ − 898 }
+ − 899 }
+ − 900 }
+ − 901
+ − 902 /* Finally, set the character */
+ − 903
+ − 904 {
+ − 905 void *table = XCHARSET_FROM_UNICODE_TABLE (charset);
+ − 906 switch (charset_levels)
+ − 907 {
+ − 908 case 1: ((short *) table)[u1] = (c1 << 8) + c2; break;
+ − 909 case 2: ((short **) table)[u2][u1] = (c1 << 8) + c2; break;
+ − 910 case 3: ((short ***) table)[u3][u2][u1] = (c1 << 8) + c2; break;
+ − 911 case 4: ((short ****) table)[u4][u3][u2][u1] = (c1 << 8) + c2; break;
+ − 912 default: abort ();
+ − 913 }
+ − 914 }
+ − 915 }
+ − 916
+ − 917 #ifdef SLEDGEHAMMER_CHECK_UNICODE
+ − 918 sledgehammer_check_unicode_tables (charset);
+ − 919 #endif
+ − 920 }
+ − 921
788
+ − 922 int
867
+ − 923 ichar_to_unicode (Ichar chr)
771
+ − 924 {
+ − 925 Lisp_Object charset;
+ − 926 int c1, c2;
+ − 927
867
+ − 928 type_checking_assert (valid_ichar_p (chr));
877
+ − 929 /* This shortcut depends on the representation of an Ichar, see text.c. */
771
+ − 930 if (chr < 256)
+ − 931 return (int) chr;
+ − 932
867
+ − 933 BREAKUP_ICHAR (chr, charset, c1, c2);
771
+ − 934 if (EQ (charset, Vcharset_composite))
+ − 935 return -1; /* #### don't know how to handle */
+ − 936 else if (XCHARSET_DIMENSION (charset) == 1)
+ − 937 return ((int *) XCHARSET_TO_UNICODE_TABLE (charset))[c1 - 32];
+ − 938 else
+ − 939 return ((int **) XCHARSET_TO_UNICODE_TABLE (charset))[c1 - 32][c2 - 32];
+ − 940 }
+ − 941
867
+ − 942 static Ichar
877
+ − 943 unicode_to_ichar (int code, Lisp_Object_dynarr *charsets)
771
+ − 944 {
+ − 945 int u1, u2, u3, u4;
+ − 946 int code_levels;
+ − 947 int i;
+ − 948 int n = Dynarr_length (charsets);
+ − 949
+ − 950 type_checking_assert (code >= 0);
877
+ − 951 /* This shortcut depends on the representation of an Ichar, see text.c.
+ − 952 Note that it may _not_ be extended to U+00A0 to U+00FF (many ISO 8859
893
+ − 953 coded character sets have points that map into that region, so this
+ − 954 function is many-valued). */
877
+ − 955 if (code < 0xA0)
867
+ − 956 return (Ichar) code;
771
+ − 957
+ − 958 BREAKUP_UNICODE_CODE (code, u4, u3, u2, u1, code_levels);
+ − 959
+ − 960 for (i = 0; i < n; i++)
+ − 961 {
+ − 962 Lisp_Object charset = Dynarr_at (charsets, i);
+ − 963 int charset_levels = XCHARSET_FROM_UNICODE_LEVELS (charset);
+ − 964 if (charset_levels >= code_levels)
+ − 965 {
+ − 966 void *table = XCHARSET_FROM_UNICODE_TABLE (charset);
+ − 967 short retval;
+ − 968
+ − 969 switch (charset_levels)
+ − 970 {
+ − 971 case 1: retval = ((short *) table)[u1]; break;
+ − 972 case 2: retval = ((short **) table)[u2][u1]; break;
+ − 973 case 3: retval = ((short ***) table)[u3][u2][u1]; break;
+ − 974 case 4: retval = ((short ****) table)[u4][u3][u2][u1]; break;
+ − 975 default: abort (); retval = 0;
+ − 976 }
+ − 977
+ − 978 if (retval != -1)
867
+ − 979 return make_ichar (charset, retval >> 8, retval & 0xFF);
771
+ − 980 }
+ − 981 }
+ − 982
867
+ − 983 return (Ichar) -1;
771
+ − 984 }
+ − 985
877
+ − 986 /* Add charsets to precedence list.
+ − 987 LIST must be a list of charsets. Charsets which are in the list more
+ − 988 than once are given the precedence implied by their earliest appearance.
+ − 989 Later appearances are ignored. */
771
+ − 990 static void
+ − 991 add_charsets_to_precedence_list (Lisp_Object list, int *lbs,
+ − 992 Lisp_Object_dynarr *dynarr)
+ − 993 {
+ − 994 {
+ − 995 EXTERNAL_LIST_LOOP_2 (elt, list)
+ − 996 {
+ − 997 Lisp_Object charset = Fget_charset (elt);
778
+ − 998 int lb = XCHARSET_LEADING_BYTE (charset);
771
+ − 999 if (lbs[lb - MIN_LEADING_BYTE] == 0)
+ − 1000 {
877
+ − 1001 Dynarr_add (dynarr, charset);
771
+ − 1002 lbs[lb - MIN_LEADING_BYTE] = 1;
+ − 1003 }
+ − 1004 }
+ − 1005 }
+ − 1006 }
+ − 1007
877
+ − 1008 /* Rebuild the charset precedence array.
+ − 1009 The "charsets preferred for the current language" get highest precedence,
+ − 1010 followed by the "charsets preferred by default", ordered as in
+ − 1011 Vlanguage_unicode_precedence_list and Vdefault_unicode_precedence_list,
+ − 1012 respectively. All remaining charsets follow in an arbitrary order. */
771
+ − 1013 void
+ − 1014 recalculate_unicode_precedence (void)
+ − 1015 {
+ − 1016 int lbs[NUM_LEADING_BYTES];
+ − 1017 int i;
+ − 1018
+ − 1019 for (i = 0; i < NUM_LEADING_BYTES; i++)
+ − 1020 lbs[i] = 0;
+ − 1021
+ − 1022 Dynarr_reset (unicode_precedence_dynarr);
+ − 1023
+ − 1024 add_charsets_to_precedence_list (Vlanguage_unicode_precedence_list,
+ − 1025 lbs, unicode_precedence_dynarr);
+ − 1026 add_charsets_to_precedence_list (Vdefault_unicode_precedence_list,
+ − 1027 lbs, unicode_precedence_dynarr);
+ − 1028
+ − 1029 for (i = 0; i < NUM_LEADING_BYTES; i++)
+ − 1030 {
+ − 1031 if (lbs[i] == 0)
+ − 1032 {
826
+ − 1033 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE);
771
+ − 1034 if (!NILP (charset))
+ − 1035 Dynarr_add (unicode_precedence_dynarr, charset);
+ − 1036 }
+ − 1037 }
+ − 1038 }
+ − 1039
877
+ − 1040 DEFUN ("unicode-precedence-list",
+ − 1041 Funicode_precedence_list,
+ − 1042 0, 0, 0, /*
+ − 1043 Return the precedence order among charsets used for Unicode decoding.
+ − 1044
+ − 1045 Value is a list of charsets, which are searched in order for a translation
+ − 1046 matching a given Unicode character.
+ − 1047
+ − 1048 The highest precedence is given to the language-specific precedence list of
+ − 1049 charsets, defined by `set-language-unicode-precedence-list'. These are
+ − 1050 followed by charsets in the default precedence list, defined by
+ − 1051 `set-default-unicode-precedence-list'. Charsets occurring multiple times are
+ − 1052 given precedence according to their first occurrance in either list. These
+ − 1053 are followed by the remaining charsets, in some arbitrary order.
771
+ − 1054
+ − 1055 The language-specific precedence list is meant to be set as part of the
+ − 1056 language environment initialization; the default precedence list is meant
+ − 1057 to be set by the user.
+ − 1058 */
877
+ − 1059 ())
+ − 1060 {
+ − 1061 int i;
+ − 1062 Lisp_Object list = Qnil;
+ − 1063
+ − 1064 for (i = Dynarr_length (unicode_precedence_dynarr) - 1; i >= 0; i--)
+ − 1065 list = Fcons (Dynarr_at (unicode_precedence_dynarr, i), list);
+ − 1066 return list;
+ − 1067 }
+ − 1068
+ − 1069
+ − 1070 /* #### This interface is wrong. Cyrillic users and Chinese users are going
+ − 1071 to have varying opinions about whether ISO Cyrillic, KOI8-R, or Windows
+ − 1072 1251 should take precedence, and whether Big Five or CNS should take
+ − 1073 precedence, respectively. This means that users are sometimes going to
+ − 1074 want to set Vlanguage_unicode_precedence_list.
+ − 1075 Furthermore, this should be language-local (buffer-local would be a
+ − 1076 reasonable approximation). */
+ − 1077 DEFUN ("set-language-unicode-precedence-list",
+ − 1078 Fset_language_unicode_precedence_list,
+ − 1079 1, 1, 0, /*
+ − 1080 Set the language-specific precedence of charsets in Unicode decoding.
+ − 1081 LIST is a list of charsets.
+ − 1082 See `unicode-precedence-list' for more information.
+ − 1083 */
771
+ − 1084 (list))
+ − 1085 {
+ − 1086 {
+ − 1087 EXTERNAL_LIST_LOOP_2 (elt, list)
+ − 1088 Fget_charset (elt);
+ − 1089 }
+ − 1090
+ − 1091 Vlanguage_unicode_precedence_list = list;
+ − 1092 recalculate_unicode_precedence ();
+ − 1093 return Qnil;
+ − 1094 }
+ − 1095
+ − 1096 DEFUN ("language-unicode-precedence-list",
+ − 1097 Flanguage_unicode_precedence_list,
+ − 1098 0, 0, 0, /*
+ − 1099 Return the language-specific precedence list used for Unicode decoding.
877
+ − 1100 See `unicode-precedence-list' for more information.
771
+ − 1101 */
+ − 1102 ())
+ − 1103 {
+ − 1104 return Vlanguage_unicode_precedence_list;
+ − 1105 }
+ − 1106
+ − 1107 DEFUN ("set-default-unicode-precedence-list",
+ − 1108 Fset_default_unicode_precedence_list,
+ − 1109 1, 1, 0, /*
+ − 1110 Set the default precedence list used for Unicode decoding.
877
+ − 1111 This is intended to be set by the user. See
+ − 1112 `unicode-precedence-list' for more information.
771
+ − 1113 */
+ − 1114 (list))
+ − 1115 {
+ − 1116 {
+ − 1117 EXTERNAL_LIST_LOOP_2 (elt, list)
+ − 1118 Fget_charset (elt);
+ − 1119 }
+ − 1120
+ − 1121 Vdefault_unicode_precedence_list = list;
+ − 1122 recalculate_unicode_precedence ();
+ − 1123 return Qnil;
+ − 1124 }
+ − 1125
+ − 1126 DEFUN ("default-unicode-precedence-list",
+ − 1127 Fdefault_unicode_precedence_list,
+ − 1128 0, 0, 0, /*
+ − 1129 Return the default precedence list used for Unicode decoding.
877
+ − 1130 See `unicode-precedence-list' for more information.
771
+ − 1131 */
+ − 1132 ())
+ − 1133 {
+ − 1134 return Vdefault_unicode_precedence_list;
+ − 1135 }
+ − 1136
+ − 1137 DEFUN ("set-unicode-conversion", Fset_unicode_conversion,
+ − 1138 2, 2, 0, /*
+ − 1139 Add conversion information between Unicode codepoints and characters.
877
+ − 1140 Conversions for U+0000 to U+00FF are hardwired to ASCII, Control-1, and
+ − 1141 Latin-1. Attempts to set these values will raise an error.
+ − 1142
771
+ − 1143 CHARACTER is one of the following:
+ − 1144
+ − 1145 -- A character (in which case CODE must be a non-negative integer; values
+ − 1146 above 2^20 - 1 are allowed for the purpose of specifying private
877
+ − 1147 characters, but are illegal in standard Unicode---they will cause errors
+ − 1148 when converted to utf-16)
771
+ − 1149 -- A vector of characters (in which case CODE must be a vector of integers
+ − 1150 of the same length)
+ − 1151 */
+ − 1152 (character, code))
+ − 1153 {
+ − 1154 Lisp_Object charset;
877
+ − 1155 int ichar, unicode;
771
+ − 1156
+ − 1157 CHECK_CHAR (character);
+ − 1158 CHECK_NATNUM (code);
+ − 1159
877
+ − 1160 unicode = XINT (code);
+ − 1161 ichar = XCHAR (character);
+ − 1162 charset = ichar_charset (ichar);
+ − 1163
+ − 1164 /* The translations of ASCII, Control-1, and Latin-1 code points are
+ − 1165 hard-coded in ichar_to_unicode and unicode_to_ichar.
+ − 1166
+ − 1167 Checking unicode < 256 && ichar != unicode is wrong because Mule gives
+ − 1168 many Latin characters code points in a few different character sets. */
+ − 1169 if ((EQ (charset, Vcharset_ascii) ||
+ − 1170 EQ (charset, Vcharset_control_1) ||
+ − 1171 EQ (charset, Vcharset_latin_iso8859_1))
+ − 1172 && unicode != ichar)
893
+ − 1173 signal_error (Qinvalid_argument, "Can't change Unicode translation for ASCII, Control-1 or Latin-1 character",
771
+ − 1174 character);
+ − 1175
877
+ − 1176 /* #### Composite characters are not properly implemented yet. */
+ − 1177 if (EQ (charset, Vcharset_composite))
+ − 1178 signal_error (Qinvalid_argument, "Can't set Unicode translation for Composite char",
+ − 1179 character);
+ − 1180
+ − 1181 set_unicode_conversion (ichar, unicode);
771
+ − 1182 return Qnil;
+ − 1183 }
+ − 1184
+ − 1185 #endif /* MULE */
+ − 1186
800
+ − 1187 DEFUN ("char-to-unicode", Fchar_to_unicode, 1, 1, 0, /*
771
+ − 1188 Convert character to Unicode codepoint.
877
+ − 1189 When there is no international support (i.e. the 'mule feature is not
+ − 1190 present), this function simply does `char-to-int'.
771
+ − 1191 */
+ − 1192 (character))
+ − 1193 {
+ − 1194 CHECK_CHAR (character);
+ − 1195 #ifdef MULE
867
+ − 1196 return make_int (ichar_to_unicode (XCHAR (character)));
771
+ − 1197 #else
+ − 1198 return Fchar_to_int (character);
+ − 1199 #endif /* MULE */
+ − 1200 }
+ − 1201
800
+ − 1202 DEFUN ("unicode-to-char", Funicode_to_char, 1, 2, 0, /*
771
+ − 1203 Convert Unicode codepoint to character.
+ − 1204 CODE should be a non-negative integer.
+ − 1205 If CHARSETS is given, it should be a list of charsets, and only those
+ − 1206 charsets will be consulted, in the given order, for a translation.
+ − 1207 Otherwise, the default ordering of all charsets will be given (see
+ − 1208 `set-unicode-charset-precedence').
+ − 1209
877
+ − 1210 When there is no international support (i.e. the 'mule feature is not
+ − 1211 present), this function simply does `int-to-char' and ignores the CHARSETS
+ − 1212 argument.
771
+ − 1213 */
+ − 1214 (code, charsets))
+ − 1215 {
+ − 1216 #ifdef MULE
+ − 1217 Lisp_Object_dynarr *dyn;
+ − 1218 int lbs[NUM_LEADING_BYTES];
+ − 1219 int c;
+ − 1220
+ − 1221 CHECK_NATNUM (code);
+ − 1222 c = XINT (code);
+ − 1223 {
+ − 1224 EXTERNAL_LIST_LOOP_2 (elt, charsets)
+ − 1225 Fget_charset (elt);
+ − 1226 }
+ − 1227
+ − 1228 if (NILP (charsets))
+ − 1229 {
877
+ − 1230 Ichar ret = unicode_to_ichar (c, unicode_precedence_dynarr);
771
+ − 1231 if (ret == -1)
+ − 1232 return Qnil;
+ − 1233 return make_char (ret);
+ − 1234 }
+ − 1235
+ − 1236 dyn = Dynarr_new (Lisp_Object);
+ − 1237 memset (lbs, 0, NUM_LEADING_BYTES * sizeof (int));
+ − 1238 add_charsets_to_precedence_list (charsets, lbs, dyn);
+ − 1239 {
877
+ − 1240 Ichar ret = unicode_to_ichar (c, dyn);
771
+ − 1241 Dynarr_free (dyn);
+ − 1242 if (ret == -1)
+ − 1243 return Qnil;
+ − 1244 return make_char (ret);
+ − 1245 }
+ − 1246 #else
+ − 1247 CHECK_NATNUM (code);
+ − 1248 return Fint_to_char (code);
+ − 1249 #endif /* MULE */
+ − 1250 }
+ − 1251
872
+ − 1252 #ifdef MULE
+ − 1253
771
+ − 1254 static Lisp_Object
+ − 1255 cerrar_el_fulano (Lisp_Object fulano)
+ − 1256 {
+ − 1257 FILE *file = (FILE *) get_opaque_ptr (fulano);
+ − 1258 retry_fclose (file);
+ − 1259 return Qnil;
+ − 1260 }
+ − 1261
877
+ − 1262 /* #### shouldn't this interface be called load-unicode-mapping-table
+ − 1263 for consistency with Unicode Consortium terminology? */
771
+ − 1264 DEFUN ("parse-unicode-translation-table", Fparse_unicode_translation_table,
+ − 1265 2, 6, 0, /*
877
+ − 1266 Load Unicode tables with the Unicode mapping data in FILENAME for CHARSET.
771
+ − 1267 Data is text, in the form of one translation per line -- charset
+ − 1268 codepoint followed by Unicode codepoint. Numbers are decimal or hex
+ − 1269 \(preceded by 0x). Comments are marked with a #. Charset codepoints
877
+ − 1270 for two-dimensional charsets have the first octet stored in the
771
+ − 1271 high 8 bits of the hex number and the second in the low 8 bits.
+ − 1272
+ − 1273 If START and END are given, only charset codepoints within the given
877
+ − 1274 range will be processed. (START and END apply to the codepoints in the
+ − 1275 file, before OFFSET is applied.)
771
+ − 1276
877
+ − 1277 If OFFSET is given, that value will be added to all charset codepoints
+ − 1278 in the file to obtain the internal charset codepoint. \(We assume
+ − 1279 that octets in the table are in the range 33 to 126 or 32 to 127. If
+ − 1280 you have a table in ku-ten form, with octets in the range 1 to 94, you
+ − 1281 will have to use an offset of 5140, i.e. 0x2020.)
771
+ − 1282
+ − 1283 FLAGS, if specified, control further how the tables are interpreted
877
+ − 1284 and are used to special-case certain known format deviations in the
+ − 1285 Unicode tables or in the charset:
771
+ − 1286
+ − 1287 `ignore-first-column'
877
+ − 1288 The JIS X 0208 tables have 3 columns of data instead of 2. The first
+ − 1289 column contains the Shift-JIS codepoint, which we ignore.
771
+ − 1290 `big5'
877
+ − 1291 The charset codepoints are Big Five codepoints; convert it to the
+ − 1292 hacked-up Mule codepoint in `chinese-big5-1' or `chinese-big5-2'.
771
+ − 1293 */
+ − 1294 (filename, charset, start, end, offset, flags))
+ − 1295 {
+ − 1296 int st = 0, en = INT_MAX, of = 0;
+ − 1297 FILE *file;
+ − 1298 struct gcpro gcpro1;
+ − 1299 char line[1025];
+ − 1300 int fondo = specpdl_depth ();
+ − 1301 int ignore_first_column = 0;
+ − 1302 int big5 = 0;
+ − 1303
+ − 1304 CHECK_STRING (filename);
+ − 1305 charset = Fget_charset (charset);
+ − 1306 if (!NILP (start))
+ − 1307 {
+ − 1308 CHECK_INT (start);
+ − 1309 st = XINT (start);
+ − 1310 }
+ − 1311 if (!NILP (end))
+ − 1312 {
+ − 1313 CHECK_INT (end);
+ − 1314 en = XINT (end);
+ − 1315 }
+ − 1316 if (!NILP (offset))
+ − 1317 {
+ − 1318 CHECK_INT (offset);
+ − 1319 of = XINT (offset);
+ − 1320 }
+ − 1321
+ − 1322 if (!LISTP (flags))
+ − 1323 flags = list1 (flags);
+ − 1324
+ − 1325 {
+ − 1326 EXTERNAL_LIST_LOOP_2 (elt, flags)
+ − 1327 {
+ − 1328 if (EQ (elt, Qignore_first_column))
+ − 1329 ignore_first_column = 1;
+ − 1330 else if (EQ (elt, Qbig5))
+ − 1331 big5 = 1;
+ − 1332 else
+ − 1333 invalid_constant
877
+ − 1334 ("Unrecognized `parse-unicode-translation-table' flag", elt);
771
+ − 1335 }
+ − 1336 }
+ − 1337
+ − 1338 GCPRO1 (filename);
+ − 1339 filename = Fexpand_file_name (filename, Qnil);
+ − 1340 file = qxe_fopen (XSTRING_DATA (filename), READ_TEXT);
+ − 1341 if (!file)
+ − 1342 report_file_error ("Cannot open", filename);
+ − 1343 record_unwind_protect (cerrar_el_fulano, make_opaque_ptr (file));
+ − 1344 while (fgets (line, sizeof (line), file))
+ − 1345 {
+ − 1346 char *p = line;
+ − 1347 int cp1, cp2, endcount;
+ − 1348 int cp1high, cp1low;
+ − 1349 int dummy;
+ − 1350
+ − 1351 while (*p) /* erase all comments out of the line */
+ − 1352 {
+ − 1353 if (*p == '#')
+ − 1354 *p = '\0';
+ − 1355 else
+ − 1356 p++;
+ − 1357 }
+ − 1358 /* see if line is nothing but whitespace and skip if so */
+ − 1359 p = line + strspn (line, " \t\n\r\f");
+ − 1360 if (!*p)
+ − 1361 continue;
+ − 1362 /* NOTE: It appears that MS Windows and Newlib sscanf() have
+ − 1363 different interpretations for whitespace (== "skip all whitespace
+ − 1364 at processing point"): Newlib requires at least one corresponding
+ − 1365 whitespace character in the input, but MS allows none. The
+ − 1366 following would be easier to write if we could count on the MS
+ − 1367 interpretation.
+ − 1368
+ − 1369 Also, the return value does NOT include %n storage. */
+ − 1370 if ((!ignore_first_column ?
+ − 1371 sscanf (p, "%i %i%n", &cp1, &cp2, &endcount) < 2 :
+ − 1372 sscanf (p, "%i %i %i%n", &dummy, &cp1, &cp2, &endcount) < 3)
+ − 1373 || *(p + endcount + strspn (p + endcount, " \t\n\r\f")))
+ − 1374 {
793
+ − 1375 warn_when_safe (Qunicode, Qwarning,
771
+ − 1376 "Unrecognized line in translation file %s:\n%s",
+ − 1377 XSTRING_DATA (filename), line);
+ − 1378 continue;
+ − 1379 }
+ − 1380 if (cp1 >= st && cp1 <= en)
+ − 1381 {
+ − 1382 cp1 += of;
+ − 1383 if (cp1 < 0 || cp1 >= 65536)
+ − 1384 {
+ − 1385 out_of_range:
793
+ − 1386 warn_when_safe (Qunicode, Qwarning,
+ − 1387 "Out of range first codepoint 0x%x in "
+ − 1388 "translation file %s:\n%s",
771
+ − 1389 cp1, XSTRING_DATA (filename), line);
+ − 1390 continue;
+ − 1391 }
+ − 1392
+ − 1393 cp1high = cp1 >> 8;
+ − 1394 cp1low = cp1 & 255;
+ − 1395
+ − 1396 if (big5)
+ − 1397 {
867
+ − 1398 Ichar ch = decode_big5_char (cp1high, cp1low);
771
+ − 1399 if (ch == -1)
793
+ − 1400
+ − 1401 warn_when_safe (Qunicode, Qwarning,
+ − 1402 "Out of range Big5 codepoint 0x%x in "
+ − 1403 "translation file %s:\n%s",
771
+ − 1404 cp1, XSTRING_DATA (filename), line);
+ − 1405 else
+ − 1406 set_unicode_conversion (ch, cp2);
+ − 1407 }
+ − 1408 else
+ − 1409 {
+ − 1410 int l1, h1, l2, h2;
867
+ − 1411 Ichar emch;
771
+ − 1412
+ − 1413 switch (XCHARSET_TYPE (charset))
+ − 1414 {
+ − 1415 case CHARSET_TYPE_94: l1 = 33; h1 = 126; l2 = 0; h2 = 0; break;
+ − 1416 case CHARSET_TYPE_96: l1 = 32; h1 = 127; l2 = 0; h2 = 0; break;
+ − 1417 case CHARSET_TYPE_94X94: l1 = 33; h1 = 126; l2 = 33; h2 = 126;
+ − 1418 break;
+ − 1419 case CHARSET_TYPE_96X96: l1 = 32; h1 = 127; l2 = 32; h2 = 127;
+ − 1420 break;
+ − 1421 default: abort (); l1 = 0; h1 = 0; l2 = 0; h2 = 0;
+ − 1422 }
+ − 1423
+ − 1424 if (cp1high < l2 || cp1high > h2 || cp1low < l1 || cp1low > h1)
+ − 1425 goto out_of_range;
+ − 1426
867
+ − 1427 emch = (cp1high == 0 ? make_ichar (charset, cp1low, 0) :
+ − 1428 make_ichar (charset, cp1high, cp1low));
771
+ − 1429 set_unicode_conversion (emch, cp2);
+ − 1430 }
+ − 1431 }
+ − 1432 }
+ − 1433
+ − 1434 if (ferror (file))
+ − 1435 report_file_error ("IO error when reading", filename);
+ − 1436
+ − 1437 unbind_to (fondo); /* close file */
+ − 1438 UNGCPRO;
+ − 1439 return Qnil;
+ − 1440 }
+ − 1441
+ − 1442 #endif /* MULE */
+ − 1443
+ − 1444
+ − 1445 /************************************************************************/
+ − 1446 /* Unicode coding system */
+ − 1447 /************************************************************************/
+ − 1448
+ − 1449 /* ISO 10646 UTF-16, UCS-4, UTF-8, UTF-7, etc. */
+ − 1450
+ − 1451 enum unicode_type
+ − 1452 {
+ − 1453 UNICODE_UTF_16,
+ − 1454 UNICODE_UTF_8,
+ − 1455 UNICODE_UTF_7,
+ − 1456 UNICODE_UCS_4,
+ − 1457 };
+ − 1458
+ − 1459 struct unicode_coding_system
+ − 1460 {
+ − 1461 enum unicode_type type;
+ − 1462 int little_endian :1;
+ − 1463 int need_bom :1;
+ − 1464 };
+ − 1465
+ − 1466 #define CODING_SYSTEM_UNICODE_TYPE(codesys) \
+ − 1467 (CODING_SYSTEM_TYPE_DATA (codesys, unicode)->type)
+ − 1468 #define XCODING_SYSTEM_UNICODE_TYPE(codesys) \
+ − 1469 CODING_SYSTEM_UNICODE_TYPE (XCODING_SYSTEM (codesys))
+ − 1470 #define CODING_SYSTEM_UNICODE_LITTLE_ENDIAN(codesys) \
+ − 1471 (CODING_SYSTEM_TYPE_DATA (codesys, unicode)->little_endian)
+ − 1472 #define XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN(codesys) \
+ − 1473 CODING_SYSTEM_UNICODE_LITTLE_ENDIAN (XCODING_SYSTEM (codesys))
+ − 1474 #define CODING_SYSTEM_UNICODE_NEED_BOM(codesys) \
+ − 1475 (CODING_SYSTEM_TYPE_DATA (codesys, unicode)->need_bom)
+ − 1476 #define XCODING_SYSTEM_UNICODE_NEED_BOM(codesys) \
+ − 1477 CODING_SYSTEM_UNICODE_NEED_BOM (XCODING_SYSTEM (codesys))
+ − 1478
+ − 1479 struct unicode_coding_stream
+ − 1480 {
+ − 1481 /* decode */
+ − 1482 unsigned char counter;
+ − 1483 int seen_char;
+ − 1484 /* encode */
+ − 1485 Lisp_Object current_charset;
+ − 1486 int current_char_boundary;
+ − 1487 int wrote_bom;
+ − 1488 };
+ − 1489
1204
+ − 1490 static const struct memory_description unicode_coding_system_description[] = {
771
+ − 1491 { XD_END }
+ − 1492 };
+ − 1493
1204
+ − 1494 DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (unicode);
+ − 1495
771
+ − 1496 /* Decode a UCS-2 or UCS-4 character into a buffer. If the lookup fails, use
+ − 1497 <GETA MARK> (U+3013) of JIS X 0208, which means correct character
+ − 1498 is not found, instead.
+ − 1499 #### do something more appropriate (use blob?)
+ − 1500 Danger, Will Robinson! Data loss. Should we signal user? */
+ − 1501 static void
+ − 1502 decode_unicode_char (int ch, unsigned_char_dynarr *dst,
+ − 1503 struct unicode_coding_stream *data, int ignore_bom)
+ − 1504 {
+ − 1505 if (ch == 0xFEFF && !data->seen_char && ignore_bom)
+ − 1506 ;
+ − 1507 else
+ − 1508 {
+ − 1509 #ifdef MULE
877
+ − 1510 Ichar chr = unicode_to_ichar (ch, unicode_precedence_dynarr);
771
+ − 1511
+ − 1512 if (chr != -1)
+ − 1513 {
867
+ − 1514 Ibyte work[MAX_ICHAR_LEN];
771
+ − 1515 int len;
+ − 1516
867
+ − 1517 len = set_itext_ichar (work, chr);
771
+ − 1518 Dynarr_add_many (dst, work, len);
+ − 1519 }
+ − 1520 else
+ − 1521 {
+ − 1522 Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
+ − 1523 Dynarr_add (dst, 34 + 128);
+ − 1524 Dynarr_add (dst, 46 + 128);
+ − 1525 }
+ − 1526 #else
867
+ − 1527 Dynarr_add (dst, (Ibyte) ch);
771
+ − 1528 #endif /* MULE */
+ − 1529 }
+ − 1530
+ − 1531 data->seen_char = 1;
+ − 1532 }
+ − 1533
+ − 1534 static void
+ − 1535 encode_unicode_char_1 (int code, unsigned_char_dynarr *dst,
+ − 1536 enum unicode_type type, int little_endian)
+ − 1537 {
+ − 1538 switch (type)
+ − 1539 {
+ − 1540 case UNICODE_UTF_16:
+ − 1541 if (little_endian)
+ − 1542 {
+ − 1543 Dynarr_add (dst, (unsigned char) (code & 255));
+ − 1544 Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ − 1545 }
+ − 1546 else
+ − 1547 {
+ − 1548 Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ − 1549 Dynarr_add (dst, (unsigned char) (code & 255));
+ − 1550 }
+ − 1551 break;
+ − 1552
+ − 1553 case UNICODE_UCS_4:
+ − 1554 if (little_endian)
+ − 1555 {
+ − 1556 Dynarr_add (dst, (unsigned char) (code & 255));
+ − 1557 Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ − 1558 Dynarr_add (dst, (unsigned char) ((code >> 16) & 255));
+ − 1559 Dynarr_add (dst, (unsigned char) (code >> 24));
+ − 1560 }
+ − 1561 else
+ − 1562 {
+ − 1563 Dynarr_add (dst, (unsigned char) (code >> 24));
+ − 1564 Dynarr_add (dst, (unsigned char) ((code >> 16) & 255));
+ − 1565 Dynarr_add (dst, (unsigned char) ((code >> 8) & 255));
+ − 1566 Dynarr_add (dst, (unsigned char) (code & 255));
+ − 1567 }
+ − 1568 break;
+ − 1569
+ − 1570 case UNICODE_UTF_8:
+ − 1571 if (code <= 0x7f)
+ − 1572 {
+ − 1573 Dynarr_add (dst, (unsigned char) code);
+ − 1574 }
+ − 1575 else if (code <= 0x7ff)
+ − 1576 {
+ − 1577 Dynarr_add (dst, (unsigned char) ((code >> 6) | 0xc0));
+ − 1578 Dynarr_add (dst, (unsigned char) ((code & 0x3f) | 0x80));
+ − 1579 }
+ − 1580 else if (code <= 0xffff)
+ − 1581 {
+ − 1582 Dynarr_add (dst, (unsigned char) ((code >> 12) | 0xe0));
+ − 1583 Dynarr_add (dst, (unsigned char) (((code >> 6) & 0x3f) | 0x80));
+ − 1584 Dynarr_add (dst, (unsigned char) ((code & 0x3f) | 0x80));
+ − 1585 }
+ − 1586 else if (code <= 0x1fffff)
+ − 1587 {
+ − 1588 Dynarr_add (dst, (unsigned char) ((code >> 18) | 0xf0));
+ − 1589 Dynarr_add (dst, (unsigned char) (((code >> 12) & 0x3f) | 0x80));
+ − 1590 Dynarr_add (dst, (unsigned char) (((code >> 6) & 0x3f) | 0x80));
+ − 1591 Dynarr_add (dst, (unsigned char) ((code & 0x3f) | 0x80));
+ − 1592 }
+ − 1593 else if (code <= 0x3ffffff)
+ − 1594 {
+ − 1595 Dynarr_add (dst, (unsigned char) ((code >> 24) | 0xf8));
+ − 1596 Dynarr_add (dst, (unsigned char) (((code >> 18) & 0x3f) | 0x80));
+ − 1597 Dynarr_add (dst, (unsigned char) (((code >> 12) & 0x3f) | 0x80));
+ − 1598 Dynarr_add (dst, (unsigned char) (((code >> 6) & 0x3f) | 0x80));
+ − 1599 Dynarr_add (dst, (unsigned char) ((code & 0x3f) | 0x80));
+ − 1600 }
+ − 1601 else
+ − 1602 {
+ − 1603 Dynarr_add (dst, (unsigned char) ((code >> 30) | 0xfc));
+ − 1604 Dynarr_add (dst, (unsigned char) (((code >> 24) & 0x3f) | 0x80));
+ − 1605 Dynarr_add (dst, (unsigned char) (((code >> 18) & 0x3f) | 0x80));
+ − 1606 Dynarr_add (dst, (unsigned char) (((code >> 12) & 0x3f) | 0x80));
+ − 1607 Dynarr_add (dst, (unsigned char) (((code >> 6) & 0x3f) | 0x80));
+ − 1608 Dynarr_add (dst, (unsigned char) ((code & 0x3f) | 0x80));
+ − 1609 }
+ − 1610 break;
+ − 1611
+ − 1612 case UNICODE_UTF_7: abort ();
+ − 1613
+ − 1614 default: abort ();
+ − 1615 }
+ − 1616 }
+ − 1617
+ − 1618 static void
+ − 1619 encode_unicode_char (Lisp_Object charset, int h, int l,
+ − 1620 unsigned_char_dynarr *dst, enum unicode_type type,
+ − 1621 int little_endian)
+ − 1622 {
+ − 1623 #ifdef MULE
867
+ − 1624 int code = ichar_to_unicode (make_ichar (charset, h & 127, l & 127));
771
+ − 1625
+ − 1626 if (code == -1)
+ − 1627 {
+ − 1628 if (type != UNICODE_UTF_16 &&
+ − 1629 XCHARSET_DIMENSION (charset) == 2 &&
+ − 1630 XCHARSET_CHARS (charset) == 94)
+ − 1631 {
+ − 1632 unsigned char final = XCHARSET_FINAL (charset);
+ − 1633
+ − 1634 if (('@' <= final) && (final < 0x7f))
+ − 1635 code = (0xe00000 + (final - '@') * 94 * 94
+ − 1636 + ((h & 127) - 33) * 94 + (l & 127) - 33);
+ − 1637 else
+ − 1638 code = '?';
+ − 1639 }
+ − 1640 else
+ − 1641 code = '?';
+ − 1642 }
+ − 1643 #else
+ − 1644 int code = h;
+ − 1645 #endif /* MULE */
+ − 1646
+ − 1647 encode_unicode_char_1 (code, dst, type, little_endian);
+ − 1648 }
+ − 1649
+ − 1650 static Bytecount
+ − 1651 unicode_convert (struct coding_stream *str, const UExtbyte *src,
+ − 1652 unsigned_char_dynarr *dst, Bytecount n)
+ − 1653 {
+ − 1654 unsigned int ch = str->ch;
+ − 1655 struct unicode_coding_stream *data = CODING_STREAM_TYPE_DATA (str, unicode);
+ − 1656 enum unicode_type type =
+ − 1657 XCODING_SYSTEM_UNICODE_TYPE (str->codesys);
+ − 1658 int little_endian = XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (str->codesys);
+ − 1659 int ignore_bom = XCODING_SYSTEM_UNICODE_NEED_BOM (str->codesys);
+ − 1660 Bytecount orign = n;
+ − 1661
+ − 1662 if (str->direction == CODING_DECODE)
+ − 1663 {
+ − 1664 unsigned char counter = data->counter;
+ − 1665
+ − 1666 while (n--)
+ − 1667 {
+ − 1668 UExtbyte c = *src++;
+ − 1669
+ − 1670 switch (type)
+ − 1671 {
+ − 1672 case UNICODE_UTF_8:
+ − 1673 switch (counter)
+ − 1674 {
+ − 1675 case 0:
+ − 1676 if (c >= 0xfc)
+ − 1677 {
+ − 1678 ch = c & 0x01;
+ − 1679 counter = 5;
+ − 1680 }
+ − 1681 else if (c >= 0xf8)
+ − 1682 {
+ − 1683 ch = c & 0x03;
+ − 1684 counter = 4;
+ − 1685 }
+ − 1686 else if (c >= 0xf0)
+ − 1687 {
+ − 1688 ch = c & 0x07;
+ − 1689 counter = 3;
+ − 1690 }
+ − 1691 else if (c >= 0xe0)
+ − 1692 {
+ − 1693 ch = c & 0x0f;
+ − 1694 counter = 2;
+ − 1695 }
+ − 1696 else if (c >= 0xc0)
+ − 1697 {
+ − 1698 ch = c & 0x1f;
+ − 1699 counter = 1;
+ − 1700 }
+ − 1701 else
+ − 1702 decode_unicode_char (c, dst, data, ignore_bom);
+ − 1703 break;
+ − 1704 case 1:
+ − 1705 ch = (ch << 6) | (c & 0x3f);
+ − 1706 decode_unicode_char (ch, dst, data, ignore_bom);
+ − 1707 ch = 0;
+ − 1708 counter = 0;
+ − 1709 break;
+ − 1710 default:
+ − 1711 ch = (ch << 6) | (c & 0x3f);
+ − 1712 counter--;
+ − 1713 }
+ − 1714 break;
+ − 1715
+ − 1716 case UNICODE_UTF_16:
+ − 1717 if (little_endian)
+ − 1718 ch = (c << counter) | ch;
+ − 1719 else
+ − 1720 ch = (ch << 8) | c;
+ − 1721 counter += 8;
+ − 1722 if (counter == 16)
+ − 1723 {
+ − 1724 int tempch = ch;
+ − 1725 ch = 0;
+ − 1726 counter = 0;
+ − 1727 decode_unicode_char (tempch, dst, data, ignore_bom);
+ − 1728 }
+ − 1729 break;
+ − 1730
+ − 1731 case UNICODE_UCS_4:
+ − 1732 if (little_endian)
+ − 1733 ch = (c << counter) | ch;
+ − 1734 else
+ − 1735 ch = (ch << 8) | c;
+ − 1736 counter += 8;
+ − 1737 if (counter == 32)
+ − 1738 {
+ − 1739 int tempch = ch;
+ − 1740 ch = 0;
+ − 1741 counter = 0;
+ − 1742 if (tempch < 0)
+ − 1743 {
+ − 1744 /* !!#### indicate an error */
+ − 1745 tempch = '~';
+ − 1746 }
+ − 1747 decode_unicode_char (tempch, dst, data, ignore_bom);
+ − 1748 }
+ − 1749 break;
+ − 1750
+ − 1751 case UNICODE_UTF_7:
+ − 1752 abort ();
+ − 1753 break;
+ − 1754
+ − 1755 default: abort ();
+ − 1756 }
+ − 1757
+ − 1758 }
+ − 1759 if (str->eof)
+ − 1760 DECODE_OUTPUT_PARTIAL_CHAR (ch, dst);
+ − 1761
+ − 1762 data->counter = counter;
+ − 1763 }
+ − 1764 else
+ − 1765 {
+ − 1766 unsigned char char_boundary = data->current_char_boundary;
+ − 1767 Lisp_Object charset = data->current_charset;
+ − 1768
+ − 1769 #ifdef ENABLE_COMPOSITE_CHARS
+ − 1770 /* flags for handling composite chars. We do a little switcheroo
+ − 1771 on the source while we're outputting the composite char. */
+ − 1772 Bytecount saved_n = 0;
867
+ − 1773 const Ibyte *saved_src = NULL;
771
+ − 1774 int in_composite = 0;
+ − 1775
+ − 1776 back_to_square_n:
+ − 1777 #endif /* ENABLE_COMPOSITE_CHARS */
+ − 1778
+ − 1779 if (XCODING_SYSTEM_UNICODE_NEED_BOM (str->codesys) && !data->wrote_bom)
+ − 1780 {
+ − 1781 encode_unicode_char_1 (0xFEFF, dst, type, little_endian);
+ − 1782 data->wrote_bom = 1;
+ − 1783 }
+ − 1784
+ − 1785 while (n--)
+ − 1786 {
867
+ − 1787 Ibyte c = *src++;
771
+ − 1788
+ − 1789 #ifdef MULE
826
+ − 1790 if (byte_ascii_p (c))
771
+ − 1791 #endif /* MULE */
+ − 1792 { /* Processing ASCII character */
+ − 1793 ch = 0;
+ − 1794 encode_unicode_char (Vcharset_ascii, c, 0, dst, type,
+ − 1795 little_endian);
+ − 1796
+ − 1797 char_boundary = 1;
+ − 1798 }
+ − 1799 #ifdef MULE
867
+ − 1800 else if (ibyte_leading_byte_p (c) || ibyte_leading_byte_p (ch))
771
+ − 1801 { /* Processing Leading Byte */
+ − 1802 ch = 0;
826
+ − 1803 charset = charset_by_leading_byte (c);
+ − 1804 if (leading_byte_prefix_p(c))
771
+ − 1805 ch = c;
+ − 1806 char_boundary = 0;
+ − 1807 }
+ − 1808 else
+ − 1809 { /* Processing Non-ASCII character */
+ − 1810 char_boundary = 1;
+ − 1811 if (EQ (charset, Vcharset_control_1))
+ − 1812 encode_unicode_char (Vcharset_control_1, c, 0, dst,
+ − 1813 type, little_endian);
+ − 1814 else
+ − 1815 {
+ − 1816 switch (XCHARSET_REP_BYTES (charset))
+ − 1817 {
+ − 1818 case 2:
+ − 1819 encode_unicode_char (charset, c, 0, dst, type,
+ − 1820 little_endian);
+ − 1821 break;
+ − 1822 case 3:
+ − 1823 if (XCHARSET_PRIVATE_P (charset))
+ − 1824 {
+ − 1825 encode_unicode_char (charset, c, 0, dst, type,
+ − 1826 little_endian);
+ − 1827 ch = 0;
+ − 1828 }
+ − 1829 else if (ch)
+ − 1830 {
+ − 1831 #ifdef ENABLE_COMPOSITE_CHARS
+ − 1832 if (EQ (charset, Vcharset_composite))
+ − 1833 {
+ − 1834 if (in_composite)
+ − 1835 {
+ − 1836 /* #### Bother! We don't know how to
+ − 1837 handle this yet. */
+ − 1838 encode_unicode_char (Vcharset_ascii, '~', 0,
+ − 1839 dst, type,
+ − 1840 little_endian);
+ − 1841 }
+ − 1842 else
+ − 1843 {
867
+ − 1844 Ichar emch = make_ichar (Vcharset_composite,
771
+ − 1845 ch & 0x7F,
+ − 1846 c & 0x7F);
+ − 1847 Lisp_Object lstr =
+ − 1848 composite_char_string (emch);
+ − 1849 saved_n = n;
+ − 1850 saved_src = src;
+ − 1851 in_composite = 1;
+ − 1852 src = XSTRING_DATA (lstr);
+ − 1853 n = XSTRING_LENGTH (lstr);
+ − 1854 }
+ − 1855 }
+ − 1856 else
+ − 1857 #endif /* ENABLE_COMPOSITE_CHARS */
+ − 1858 encode_unicode_char (charset, ch, c, dst, type,
+ − 1859 little_endian);
+ − 1860 ch = 0;
+ − 1861 }
+ − 1862 else
+ − 1863 {
+ − 1864 ch = c;
+ − 1865 char_boundary = 0;
+ − 1866 }
+ − 1867 break;
+ − 1868 case 4:
+ − 1869 if (ch)
+ − 1870 {
+ − 1871 encode_unicode_char (charset, ch, c, dst, type,
+ − 1872 little_endian);
+ − 1873 ch = 0;
+ − 1874 }
+ − 1875 else
+ − 1876 {
+ − 1877 ch = c;
+ − 1878 char_boundary = 0;
+ − 1879 }
+ − 1880 break;
+ − 1881 default:
+ − 1882 abort ();
+ − 1883 }
+ − 1884 }
+ − 1885 }
+ − 1886 #endif /* MULE */
+ − 1887 }
+ − 1888
+ − 1889 #ifdef ENABLE_COMPOSITE_CHARS
+ − 1890 if (in_composite)
+ − 1891 {
+ − 1892 n = saved_n;
+ − 1893 src = saved_src;
+ − 1894 in_composite = 0;
+ − 1895 goto back_to_square_n; /* Wheeeeeeeee ..... */
+ − 1896 }
+ − 1897 #endif /* ENABLE_COMPOSITE_CHARS */
+ − 1898
+ − 1899 data->current_char_boundary = char_boundary;
+ − 1900 data->current_charset = charset;
+ − 1901
+ − 1902 /* La palabra se hizo carne! */
+ − 1903 /* A palavra fez-se carne! */
+ − 1904 /* Whatever. */
+ − 1905 }
+ − 1906
+ − 1907 str->ch = ch;
+ − 1908 return orign;
+ − 1909 }
+ − 1910
+ − 1911 /* DEFINE_DETECTOR (utf_7); */
+ − 1912 DEFINE_DETECTOR (utf_8);
+ − 1913 DEFINE_DETECTOR_CATEGORY (utf_8, utf_8);
985
+ − 1914 DEFINE_DETECTOR_CATEGORY (utf_8, utf_8_bom);
771
+ − 1915 DEFINE_DETECTOR (ucs_4);
+ − 1916 DEFINE_DETECTOR_CATEGORY (ucs_4, ucs_4);
+ − 1917 DEFINE_DETECTOR (utf_16);
+ − 1918 DEFINE_DETECTOR_CATEGORY (utf_16, utf_16);
+ − 1919 DEFINE_DETECTOR_CATEGORY (utf_16, utf_16_little_endian);
+ − 1920 DEFINE_DETECTOR_CATEGORY (utf_16, utf_16_bom);
+ − 1921 DEFINE_DETECTOR_CATEGORY (utf_16, utf_16_little_endian_bom);
+ − 1922
+ − 1923 struct ucs_4_detector
+ − 1924 {
+ − 1925 int in_ucs_4_byte;
+ − 1926 };
+ − 1927
+ − 1928 static void
+ − 1929 ucs_4_detect (struct detection_state *st, const UExtbyte *src,
+ − 1930 Bytecount n)
+ − 1931 {
+ − 1932 struct ucs_4_detector *data = DETECTION_STATE_DATA (st, ucs_4);
+ − 1933
+ − 1934 while (n--)
+ − 1935 {
+ − 1936 UExtbyte c = *src++;
+ − 1937 switch (data->in_ucs_4_byte)
+ − 1938 {
+ − 1939 case 0:
+ − 1940 if (c >= 128)
+ − 1941 {
+ − 1942 DET_RESULT (st, ucs_4) = DET_NEARLY_IMPOSSIBLE;
+ − 1943 return;
+ − 1944 }
+ − 1945 else
+ − 1946 data->in_ucs_4_byte++;
+ − 1947 break;
+ − 1948 case 3:
+ − 1949 data->in_ucs_4_byte = 0;
+ − 1950 break;
+ − 1951 default:
+ − 1952 data->in_ucs_4_byte++;
+ − 1953 }
+ − 1954 }
+ − 1955
+ − 1956 /* !!#### write this for real */
+ − 1957 DET_RESULT (st, ucs_4) = DET_AS_LIKELY_AS_UNLIKELY;
+ − 1958 }
+ − 1959
+ − 1960 struct utf_16_detector
+ − 1961 {
+ − 1962 unsigned int seen_ffff:1;
+ − 1963 unsigned int seen_forward_bom:1;
+ − 1964 unsigned int seen_rev_bom:1;
+ − 1965 int byteno;
+ − 1966 int prev_char;
+ − 1967 int text, rev_text;
1267
+ − 1968 int sep, rev_sep;
+ − 1969 int num_ascii;
771
+ − 1970 };
+ − 1971
+ − 1972 static void
+ − 1973 utf_16_detect (struct detection_state *st, const UExtbyte *src,
+ − 1974 Bytecount n)
+ − 1975 {
+ − 1976 struct utf_16_detector *data = DETECTION_STATE_DATA (st, utf_16);
+ − 1977
+ − 1978 while (n--)
+ − 1979 {
+ − 1980 UExtbyte c = *src++;
+ − 1981 int prevc = data->prev_char;
+ − 1982 if (data->byteno == 1 && c == 0xFF && prevc == 0xFE)
+ − 1983 data->seen_forward_bom = 1;
+ − 1984 else if (data->byteno == 1 && c == 0xFE && prevc == 0xFF)
+ − 1985 data->seen_rev_bom = 1;
+ − 1986
+ − 1987 if (data->byteno & 1)
+ − 1988 {
+ − 1989 if (c == 0xFF && prevc == 0xFF)
+ − 1990 data->seen_ffff = 1;
+ − 1991 if (prevc == 0
+ − 1992 && (c == '\r' || c == '\n'
+ − 1993 || (c >= 0x20 && c <= 0x7E)))
+ − 1994 data->text++;
+ − 1995 if (c == 0
+ − 1996 && (prevc == '\r' || prevc == '\n'
+ − 1997 || (prevc >= 0x20 && prevc <= 0x7E)))
+ − 1998 data->rev_text++;
1267
+ − 1999 /* #### 0x2028 is LINE SEPARATOR and 0x2029 is PARAGRAPH SEPARATOR.
+ − 2000 I used to count these in text and rev_text but that is very bad,
+ − 2001 as 0x2028 is also space + left-paren in ASCII, which is extremely
+ − 2002 common. So, what do we do with these? */
771
+ − 2003 if (prevc == 0x20 && (c == 0x28 || c == 0x29))
1267
+ − 2004 data->sep++;
771
+ − 2005 if (c == 0x20 && (prevc == 0x28 || prevc == 0x29))
1267
+ − 2006 data->rev_sep++;
771
+ − 2007 }
+ − 2008
1267
+ − 2009 if ((c >= ' ' && c <= '~') || c == '\n' || c == '\r' || c == '\t' ||
+ − 2010 c == '\f' || c == '\v')
+ − 2011 data->num_ascii++;
771
+ − 2012 data->byteno++;
+ − 2013 data->prev_char = c;
+ − 2014 }
+ − 2015
+ − 2016 {
+ − 2017 int variance_indicates_big_endian =
+ − 2018 (data->text >= 10
+ − 2019 && (data->rev_text == 0
+ − 2020 || data->text / data->rev_text >= 10));
+ − 2021 int variance_indicates_little_endian =
+ − 2022 (data->rev_text >= 10
+ − 2023 && (data->text == 0
+ − 2024 || data->rev_text / data->text >= 10));
+ − 2025
+ − 2026 if (data->seen_ffff)
+ − 2027 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2028 else if (data->seen_forward_bom)
+ − 2029 {
+ − 2030 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2031 if (variance_indicates_big_endian)
+ − 2032 DET_RESULT (st, utf_16_bom) = DET_NEAR_CERTAINTY;
+ − 2033 else if (variance_indicates_little_endian)
+ − 2034 DET_RESULT (st, utf_16_bom) = DET_SOMEWHAT_LIKELY;
+ − 2035 else
+ − 2036 DET_RESULT (st, utf_16_bom) = DET_QUITE_PROBABLE;
+ − 2037 }
+ − 2038 else if (data->seen_forward_bom)
+ − 2039 {
+ − 2040 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2041 if (variance_indicates_big_endian)
+ − 2042 DET_RESULT (st, utf_16_bom) = DET_NEAR_CERTAINTY;
+ − 2043 else if (variance_indicates_little_endian)
+ − 2044 /* #### may need to rethink */
+ − 2045 DET_RESULT (st, utf_16_bom) = DET_SOMEWHAT_LIKELY;
+ − 2046 else
+ − 2047 /* #### may need to rethink */
+ − 2048 DET_RESULT (st, utf_16_bom) = DET_QUITE_PROBABLE;
+ − 2049 }
+ − 2050 else if (data->seen_rev_bom)
+ − 2051 {
+ − 2052 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2053 if (variance_indicates_little_endian)
+ − 2054 DET_RESULT (st, utf_16_little_endian_bom) = DET_NEAR_CERTAINTY;
+ − 2055 else if (variance_indicates_big_endian)
+ − 2056 /* #### may need to rethink */
+ − 2057 DET_RESULT (st, utf_16_little_endian_bom) = DET_SOMEWHAT_LIKELY;
+ − 2058 else
+ − 2059 /* #### may need to rethink */
+ − 2060 DET_RESULT (st, utf_16_little_endian_bom) = DET_QUITE_PROBABLE;
+ − 2061 }
+ − 2062 else if (variance_indicates_big_endian)
+ − 2063 {
+ − 2064 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2065 DET_RESULT (st, utf_16) = DET_SOMEWHAT_LIKELY;
+ − 2066 DET_RESULT (st, utf_16_little_endian) = DET_SOMEWHAT_UNLIKELY;
+ − 2067 }
+ − 2068 else if (variance_indicates_little_endian)
+ − 2069 {
+ − 2070 SET_DET_RESULTS (st, utf_16, DET_NEARLY_IMPOSSIBLE);
+ − 2071 DET_RESULT (st, utf_16) = DET_SOMEWHAT_UNLIKELY;
+ − 2072 DET_RESULT (st, utf_16_little_endian) = DET_SOMEWHAT_LIKELY;
+ − 2073 }
+ − 2074 else
1267
+ − 2075 {
+ − 2076 /* #### FUCKME! There should really be an ASCII detector. This
+ − 2077 would rule out the need to have this built-in here as
+ − 2078 well. --ben */
+ − 2079 int pct_ascii = ((100 * data->num_ascii) / data->byteno);
+ − 2080
+ − 2081 if (pct_ascii > 90)
+ − 2082 SET_DET_RESULTS (st, utf_16, DET_QUITE_IMPROBABLE);
+ − 2083 else if (pct_ascii > 75)
+ − 2084 SET_DET_RESULTS (st, utf_16, DET_SOMEWHAT_UNLIKELY);
+ − 2085 else
+ − 2086 SET_DET_RESULTS (st, utf_16, DET_AS_LIKELY_AS_UNLIKELY);
+ − 2087 }
771
+ − 2088 }
+ − 2089 }
+ − 2090
+ − 2091 struct utf_8_detector
+ − 2092 {
985
+ − 2093 int byteno;
+ − 2094 int first_byte;
+ − 2095 int second_byte;
1267
+ − 2096 int prev_byte;
771
+ − 2097 int in_utf_8_byte;
1267
+ − 2098 int recent_utf_8_sequence;
+ − 2099 int seen_bogus_utf8;
+ − 2100 int seen_really_bogus_utf8;
+ − 2101 int seen_2byte_sequence;
+ − 2102 int seen_longer_sequence;
+ − 2103 int seen_iso2022_esc;
+ − 2104 int seen_iso_shift;
+ − 2105 int seen_utf_bom:1;
771
+ − 2106 };
+ − 2107
+ − 2108 static void
+ − 2109 utf_8_detect (struct detection_state *st, const UExtbyte *src,
+ − 2110 Bytecount n)
+ − 2111 {
+ − 2112 struct utf_8_detector *data = DETECTION_STATE_DATA (st, utf_8);
+ − 2113
+ − 2114 while (n--)
+ − 2115 {
+ − 2116 UExtbyte c = *src++;
985
+ − 2117 switch (data->byteno)
+ − 2118 {
+ − 2119 case 0:
+ − 2120 data->first_byte = c;
+ − 2121 break;
+ − 2122 case 1:
+ − 2123 data->second_byte = c;
+ − 2124 break;
+ − 2125 case 2:
+ − 2126 if (data->first_byte == 0xef &&
+ − 2127 data->second_byte == 0xbb &&
+ − 2128 c == 0xbf)
1267
+ − 2129 data->seen_utf_bom = 1;
985
+ − 2130 break;
+ − 2131 }
+ − 2132
771
+ − 2133 switch (data->in_utf_8_byte)
+ − 2134 {
+ − 2135 case 0:
1267
+ − 2136 if (data->prev_byte == ISO_CODE_ESC && c >= 0x28 && c <= 0x2F)
+ − 2137 data->seen_iso2022_esc++;
+ − 2138 else if (c == ISO_CODE_SI || c == ISO_CODE_SO)
+ − 2139 data->seen_iso_shift++;
771
+ − 2140 else if (c >= 0xfc)
+ − 2141 data->in_utf_8_byte = 5;
+ − 2142 else if (c >= 0xf8)
+ − 2143 data->in_utf_8_byte = 4;
+ − 2144 else if (c >= 0xf0)
+ − 2145 data->in_utf_8_byte = 3;
+ − 2146 else if (c >= 0xe0)
+ − 2147 data->in_utf_8_byte = 2;
+ − 2148 else if (c >= 0xc0)
+ − 2149 data->in_utf_8_byte = 1;
+ − 2150 else if (c >= 0x80)
1267
+ − 2151 data->seen_bogus_utf8++;
+ − 2152 if (data->in_utf_8_byte > 0)
+ − 2153 data->recent_utf_8_sequence = data->in_utf_8_byte;
771
+ − 2154 break;
+ − 2155 default:
+ − 2156 if ((c & 0xc0) != 0x80)
1267
+ − 2157 data->seen_really_bogus_utf8++;
+ − 2158 else
771
+ − 2159 {
1267
+ − 2160 data->in_utf_8_byte--;
+ − 2161 if (data->in_utf_8_byte == 0)
+ − 2162 {
+ − 2163 if (data->recent_utf_8_sequence == 1)
+ − 2164 data->seen_2byte_sequence++;
+ − 2165 else
+ − 2166 {
+ − 2167 assert (data->recent_utf_8_sequence >= 2);
+ − 2168 data->seen_longer_sequence++;
+ − 2169 }
+ − 2170 }
771
+ − 2171 }
+ − 2172 }
985
+ − 2173
+ − 2174 data->byteno++;
1267
+ − 2175 data->prev_byte = c;
771
+ − 2176 }
1267
+ − 2177
+ − 2178 /* either BOM or no BOM, but not both */
+ − 2179 SET_DET_RESULTS (st, utf_8, DET_NEARLY_IMPOSSIBLE);
+ − 2180
+ − 2181
+ − 2182 if (data->seen_utf_bom)
+ − 2183 DET_RESULT (st, utf_8_bom) = DET_NEAR_CERTAINTY;
+ − 2184 else
+ − 2185 {
+ − 2186 if (data->seen_really_bogus_utf8 ||
+ − 2187 data->seen_bogus_utf8 >= 2)
+ − 2188 ; /* bogus */
+ − 2189 else if (data->seen_bogus_utf8)
+ − 2190 DET_RESULT (st, utf_8) = DET_SOMEWHAT_UNLIKELY;
+ − 2191 else if ((data->seen_longer_sequence >= 5 ||
+ − 2192 data->seen_2byte_sequence >= 10) &&
+ − 2193 (!(data->seen_iso2022_esc + data->seen_iso_shift) ||
+ − 2194 (data->seen_longer_sequence * 2 + data->seen_2byte_sequence) /
+ − 2195 (data->seen_iso2022_esc + data->seen_iso_shift) >= 10))
+ − 2196 /* heuristics, heuristics, we love heuristics */
+ − 2197 DET_RESULT (st, utf_8) = DET_QUITE_PROBABLE;
+ − 2198 else if (data->seen_iso2022_esc ||
+ − 2199 data->seen_iso_shift >= 3)
+ − 2200 DET_RESULT (st, utf_8) = DET_SOMEWHAT_UNLIKELY;
+ − 2201 else if (data->seen_longer_sequence ||
+ − 2202 data->seen_2byte_sequence)
+ − 2203 DET_RESULT (st, utf_8) = DET_SOMEWHAT_LIKELY;
+ − 2204 else if (data->seen_iso_shift)
+ − 2205 DET_RESULT (st, utf_8) = DET_SOMEWHAT_UNLIKELY;
+ − 2206 else
+ − 2207 DET_RESULT (st, utf_8) = DET_AS_LIKELY_AS_UNLIKELY;
+ − 2208 }
771
+ − 2209 }
+ − 2210
+ − 2211 static void
+ − 2212 unicode_init_coding_stream (struct coding_stream *str)
+ − 2213 {
+ − 2214 struct unicode_coding_stream *data =
+ − 2215 CODING_STREAM_TYPE_DATA (str, unicode);
+ − 2216 xzero (*data);
+ − 2217 data->current_charset = Qnil;
+ − 2218 }
+ − 2219
+ − 2220 static void
+ − 2221 unicode_rewind_coding_stream (struct coding_stream *str)
+ − 2222 {
+ − 2223 unicode_init_coding_stream (str);
+ − 2224 }
+ − 2225
+ − 2226 static int
+ − 2227 unicode_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value)
+ − 2228 {
+ − 2229 if (EQ (key, Qtype))
+ − 2230 {
+ − 2231 enum unicode_type type;
+ − 2232
+ − 2233 if (EQ (value, Qutf_8))
+ − 2234 type = UNICODE_UTF_8;
+ − 2235 else if (EQ (value, Qutf_16))
+ − 2236 type = UNICODE_UTF_16;
+ − 2237 else if (EQ (value, Qutf_7))
+ − 2238 type = UNICODE_UTF_7;
+ − 2239 else if (EQ (value, Qucs_4))
+ − 2240 type = UNICODE_UCS_4;
+ − 2241 else
+ − 2242 invalid_constant ("Invalid Unicode type", key);
+ − 2243
+ − 2244 XCODING_SYSTEM_UNICODE_TYPE (codesys) = type;
+ − 2245 }
+ − 2246 else if (EQ (key, Qlittle_endian))
+ − 2247 XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (codesys) = !NILP (value);
+ − 2248 else if (EQ (key, Qneed_bom))
+ − 2249 XCODING_SYSTEM_UNICODE_NEED_BOM (codesys) = !NILP (value);
+ − 2250 else
+ − 2251 return 0;
+ − 2252 return 1;
+ − 2253 }
+ − 2254
+ − 2255 static Lisp_Object
+ − 2256 unicode_getprop (Lisp_Object coding_system, Lisp_Object prop)
+ − 2257 {
+ − 2258 if (EQ (prop, Qtype))
+ − 2259 {
+ − 2260 switch (XCODING_SYSTEM_UNICODE_TYPE (coding_system))
+ − 2261 {
+ − 2262 case UNICODE_UTF_16: return Qutf_16;
+ − 2263 case UNICODE_UTF_8: return Qutf_8;
+ − 2264 case UNICODE_UTF_7: return Qutf_7;
+ − 2265 case UNICODE_UCS_4: return Qucs_4;
+ − 2266 default: abort ();
+ − 2267 }
+ − 2268 }
+ − 2269 else if (EQ (prop, Qlittle_endian))
+ − 2270 return XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (coding_system) ? Qt : Qnil;
+ − 2271 else if (EQ (prop, Qneed_bom))
+ − 2272 return XCODING_SYSTEM_UNICODE_NEED_BOM (coding_system) ? Qt : Qnil;
+ − 2273 return Qunbound;
+ − 2274 }
+ − 2275
+ − 2276 static void
+ − 2277 unicode_print (Lisp_Object cs, Lisp_Object printcharfun, int escapeflag)
+ − 2278 {
800
+ − 2279 write_fmt_string_lisp (printcharfun, "(%s", 1, unicode_getprop (cs, Qtype));
771
+ − 2280 if (XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (cs))
826
+ − 2281 write_c_string (printcharfun, ", little-endian");
771
+ − 2282 if (XCODING_SYSTEM_UNICODE_NEED_BOM (cs))
826
+ − 2283 write_c_string (printcharfun, ", need-bom");
+ − 2284 write_c_string (printcharfun, ")");
771
+ − 2285 }
+ − 2286
+ − 2287 int
+ − 2288 dfc_coding_system_is_unicode (Lisp_Object codesys)
+ − 2289 {
+ − 2290 #ifdef HAVE_WIN32_CODING_SYSTEMS
+ − 2291 codesys = Fget_coding_system (codesys);
+ − 2292 return (EQ (XCODING_SYSTEM_TYPE (codesys), Qunicode) &&
+ − 2293 XCODING_SYSTEM_UNICODE_TYPE (codesys) == UNICODE_UTF_16 &&
+ − 2294 XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (codesys));
+ − 2295
+ − 2296 #else
+ − 2297 return 0;
+ − 2298 #endif
+ − 2299 }
+ − 2300
+ − 2301
+ − 2302 /************************************************************************/
+ − 2303 /* Initialization */
+ − 2304 /************************************************************************/
+ − 2305
+ − 2306 void
+ − 2307 syms_of_unicode (void)
+ − 2308 {
+ − 2309 #ifdef MULE
877
+ − 2310 DEFSUBR (Funicode_precedence_list);
771
+ − 2311 DEFSUBR (Fset_language_unicode_precedence_list);
+ − 2312 DEFSUBR (Flanguage_unicode_precedence_list);
+ − 2313 DEFSUBR (Fset_default_unicode_precedence_list);
+ − 2314 DEFSUBR (Fdefault_unicode_precedence_list);
+ − 2315 DEFSUBR (Fset_unicode_conversion);
+ − 2316
+ − 2317 DEFSUBR (Fparse_unicode_translation_table);
+ − 2318
+ − 2319 DEFSYMBOL (Qignore_first_column);
+ − 2320 #endif /* MULE */
+ − 2321
800
+ − 2322 DEFSUBR (Fchar_to_unicode);
+ − 2323 DEFSUBR (Funicode_to_char);
771
+ − 2324
+ − 2325 DEFSYMBOL (Qunicode);
+ − 2326 DEFSYMBOL (Qucs_4);
+ − 2327 DEFSYMBOL (Qutf_16);
+ − 2328 DEFSYMBOL (Qutf_8);
+ − 2329 DEFSYMBOL (Qutf_7);
+ − 2330
+ − 2331 DEFSYMBOL (Qneed_bom);
+ − 2332
+ − 2333 DEFSYMBOL (Qutf_16);
+ − 2334 DEFSYMBOL (Qutf_16_little_endian);
+ − 2335 DEFSYMBOL (Qutf_16_bom);
+ − 2336 DEFSYMBOL (Qutf_16_little_endian_bom);
985
+ − 2337
+ − 2338 DEFSYMBOL (Qutf_8);
+ − 2339 DEFSYMBOL (Qutf_8_bom);
771
+ − 2340 }
+ − 2341
+ − 2342 void
+ − 2343 coding_system_type_create_unicode (void)
+ − 2344 {
+ − 2345 INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (unicode, "unicode-coding-system-p");
+ − 2346 CODING_SYSTEM_HAS_METHOD (unicode, print);
+ − 2347 CODING_SYSTEM_HAS_METHOD (unicode, convert);
+ − 2348 CODING_SYSTEM_HAS_METHOD (unicode, init_coding_stream);
+ − 2349 CODING_SYSTEM_HAS_METHOD (unicode, rewind_coding_stream);
+ − 2350 CODING_SYSTEM_HAS_METHOD (unicode, putprop);
+ − 2351 CODING_SYSTEM_HAS_METHOD (unicode, getprop);
+ − 2352
+ − 2353 INITIALIZE_DETECTOR (utf_8);
+ − 2354 DETECTOR_HAS_METHOD (utf_8, detect);
+ − 2355 INITIALIZE_DETECTOR_CATEGORY (utf_8, utf_8);
985
+ − 2356 INITIALIZE_DETECTOR_CATEGORY (utf_8, utf_8_bom);
771
+ − 2357
+ − 2358 INITIALIZE_DETECTOR (ucs_4);
+ − 2359 DETECTOR_HAS_METHOD (ucs_4, detect);
+ − 2360 INITIALIZE_DETECTOR_CATEGORY (ucs_4, ucs_4);
+ − 2361
+ − 2362 INITIALIZE_DETECTOR (utf_16);
+ − 2363 DETECTOR_HAS_METHOD (utf_16, detect);
+ − 2364 INITIALIZE_DETECTOR_CATEGORY (utf_16, utf_16);
+ − 2365 INITIALIZE_DETECTOR_CATEGORY (utf_16, utf_16_little_endian);
+ − 2366 INITIALIZE_DETECTOR_CATEGORY (utf_16, utf_16_bom);
+ − 2367 INITIALIZE_DETECTOR_CATEGORY (utf_16, utf_16_little_endian_bom);
+ − 2368 }
+ − 2369
+ − 2370 void
+ − 2371 reinit_coding_system_type_create_unicode (void)
+ − 2372 {
+ − 2373 REINITIALIZE_CODING_SYSTEM_TYPE (unicode);
+ − 2374 }
+ − 2375
+ − 2376 void
+ − 2377 reinit_vars_of_unicode (void)
+ − 2378 {
+ − 2379 #ifdef MULE
+ − 2380 init_blank_unicode_tables ();
+ − 2381 #endif /* MULE */
+ − 2382 }
+ − 2383
+ − 2384 void
+ − 2385 vars_of_unicode (void)
+ − 2386 {
+ − 2387 reinit_vars_of_unicode ();
+ − 2388
+ − 2389 Fprovide (intern ("unicode"));
+ − 2390
+ − 2391 #ifdef MULE
+ − 2392 staticpro (&Vlanguage_unicode_precedence_list);
+ − 2393 Vlanguage_unicode_precedence_list = Qnil;
+ − 2394
+ − 2395 staticpro (&Vdefault_unicode_precedence_list);
+ − 2396 Vdefault_unicode_precedence_list = Qnil;
+ − 2397
+ − 2398 unicode_precedence_dynarr = Dynarr_new (Lisp_Object);
+ − 2399 dump_add_root_struct_ptr (&unicode_precedence_dynarr,
+ − 2400 &lisp_object_dynarr_description);
+ − 2401 #endif /* MULE */
+ − 2402 }
