381 |
|
|
382 |
#ifdef emacs |
#ifdef emacs |
383 |
|
|
384 |
|
/* Information about which coding system is safe for which chars. |
385 |
|
The value has the form (GENERIC-LIST . NON-GENERIC-ALIST). |
386 |
|
|
387 |
|
GENERIC-LIST is a list of generic coding systems which can encode |
388 |
|
any characters. |
389 |
|
|
390 |
|
NON-GENERIC-ALIST is an alist of non generic coding systems vs the |
391 |
|
corresponding char table that contains safe chars. */ |
392 |
|
Lisp_Object Vcoding_system_safe_chars; |
393 |
|
|
394 |
Lisp_Object Vcoding_system_list, Vcoding_system_alist; |
Lisp_Object Vcoding_system_list, Vcoding_system_alist; |
395 |
|
|
396 |
Lisp_Object Qcoding_system_p, Qcoding_system_error; |
Lisp_Object Qcoding_system_p, Qcoding_system_error; |
510 |
Lisp_Object Vchar_coding_system_table; |
Lisp_Object Vchar_coding_system_table; |
511 |
Lisp_Object Qchar_coding_system; |
Lisp_Object Qchar_coding_system; |
512 |
|
|
513 |
/* Return `safe-chars' property of coding system CODING. Don't check |
/* Return `safe-chars' property of CODING_SYSTEM (symbol). Don't check |
514 |
validity of CODING. */ |
its validity. */ |
515 |
|
|
516 |
Lisp_Object |
Lisp_Object |
517 |
coding_safe_chars (coding) |
coding_safe_chars (coding_system) |
518 |
struct coding_system *coding; |
Lisp_Object coding_system; |
519 |
{ |
{ |
520 |
Lisp_Object coding_spec, plist, safe_chars; |
Lisp_Object coding_spec, plist, safe_chars; |
521 |
|
|
522 |
coding_spec = Fget (coding->symbol, Qcoding_system); |
coding_spec = Fget (coding_system, Qcoding_system); |
523 |
plist = XVECTOR (coding_spec)->contents[3]; |
plist = XVECTOR (coding_spec)->contents[3]; |
524 |
safe_chars = Fplist_get (XVECTOR (coding_spec)->contents[3], Qsafe_chars); |
safe_chars = Fplist_get (XVECTOR (coding_spec)->contents[3], Qsafe_chars); |
525 |
return (CHAR_TABLE_P (safe_chars) ? safe_chars : Qt); |
return (CHAR_TABLE_P (safe_chars) ? safe_chars : Qt); |
1320 |
#define CHARSET_OK(idx, charset, c) \ |
#define CHARSET_OK(idx, charset, c) \ |
1321 |
(coding_system_table[idx] \ |
(coding_system_table[idx] \ |
1322 |
&& (charset == CHARSET_ASCII \ |
&& (charset == CHARSET_ASCII \ |
1323 |
|| (safe_chars = coding_safe_chars (coding_system_table[idx]), \ |
|| (safe_chars = coding_safe_chars (coding_system_table[idx]->symbol), \ |
1324 |
CODING_SAFE_CHAR_P (safe_chars, c))) \ |
CODING_SAFE_CHAR_P (safe_chars, c))) \ |
1325 |
&& (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding_system_table[idx], \ |
&& (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding_system_table[idx], \ |
1326 |
charset) \ |
charset) \ |
1749 |
Lisp_Object translation_table; |
Lisp_Object translation_table; |
1750 |
Lisp_Object safe_chars; |
Lisp_Object safe_chars; |
1751 |
|
|
1752 |
safe_chars = coding_safe_chars (coding); |
safe_chars = coding_safe_chars (coding->symbol); |
1753 |
|
|
1754 |
if (NILP (Venable_character_translation)) |
if (NILP (Venable_character_translation)) |
1755 |
translation_table = Qnil; |
translation_table = Qnil; |
2502 |
Lisp_Object translation_table; |
Lisp_Object translation_table; |
2503 |
Lisp_Object safe_chars; |
Lisp_Object safe_chars; |
2504 |
|
|
2505 |
safe_chars = coding_safe_chars (coding); |
safe_chars = coding_safe_chars (coding->symbol); |
2506 |
|
|
2507 |
if (NILP (Venable_character_translation)) |
if (NILP (Venable_character_translation)) |
2508 |
translation_table = Qnil; |
translation_table = Qnil; |
6505 |
} |
} |
6506 |
|
|
6507 |
|
|
6508 |
|
static Lisp_Object |
6509 |
|
find_safe_codings_2 (p, pend, safe_codings, work_table, single_byte_char_found) |
6510 |
|
unsigned char *p, *pend; |
6511 |
|
Lisp_Object safe_codings, work_table; |
6512 |
|
int *single_byte_char_found; |
6513 |
|
{ |
6514 |
|
int c, len, i; |
6515 |
|
Lisp_Object val, ch; |
6516 |
|
Lisp_Object prev, tail; |
6517 |
|
|
6518 |
|
while (p < pend) |
6519 |
|
{ |
6520 |
|
c = STRING_CHAR_AND_LENGTH (p, pend - p, len); |
6521 |
|
p += len; |
6522 |
|
if (ASCII_BYTE_P (c)) |
6523 |
|
/* We can ignore ASCII characters here. */ |
6524 |
|
continue; |
6525 |
|
if (SINGLE_BYTE_CHAR_P (c)) |
6526 |
|
*single_byte_char_found = 1; |
6527 |
|
if (NILP (safe_codings)) |
6528 |
|
/* Already all coding systems are excluded. */ |
6529 |
|
continue; |
6530 |
|
/* Check the safe coding systems for C. */ |
6531 |
|
ch = make_number (c); |
6532 |
|
val = Faref (work_table, ch); |
6533 |
|
if (EQ (val, Qt)) |
6534 |
|
/* This element was already checked. Ignore it. */ |
6535 |
|
continue; |
6536 |
|
/* Remember that we checked this element. */ |
6537 |
|
Faset (work_table, ch, Qt); |
6538 |
|
|
6539 |
|
for (prev = tail = safe_codings; CONSP (tail); tail = XCDR (tail)) |
6540 |
|
{ |
6541 |
|
val = XCAR (tail); |
6542 |
|
if (NILP (Faref (XCDR (val), ch))) |
6543 |
|
{ |
6544 |
|
/* Exclued this coding system from SAFE_CODINGS. */ |
6545 |
|
if (EQ (tail, safe_codings)) |
6546 |
|
safe_codings = XCDR (safe_codings); |
6547 |
|
else |
6548 |
|
XSETCDR (prev, XCDR (tail)); |
6549 |
|
} |
6550 |
|
else |
6551 |
|
prev = tail; |
6552 |
|
} |
6553 |
|
} |
6554 |
|
return safe_codings; |
6555 |
|
} |
6556 |
|
|
6557 |
|
DEFUN ("find-coding-systems-region-internal-2", |
6558 |
|
Ffind_coding_systems_region_internal_2, |
6559 |
|
Sfind_coding_systems_region_internal_2, 2, 2, 0, |
6560 |
|
doc: /* Internal use only. */) |
6561 |
|
(start, end) |
6562 |
|
Lisp_Object start, end; |
6563 |
|
{ |
6564 |
|
Lisp_Object work_table, safe_codings; |
6565 |
|
int non_ascii_p = 0; |
6566 |
|
int single_byte_char_found = 0; |
6567 |
|
const unsigned char *p1, *p1end, *p2, *p2end, *p; |
6568 |
|
|
6569 |
|
if (STRINGP (start)) |
6570 |
|
{ |
6571 |
|
if (!STRING_MULTIBYTE (start)) |
6572 |
|
return Qt; |
6573 |
|
p1 = SDATA (start), p1end = p1 + SBYTES (start); |
6574 |
|
p2 = p2end = p1end; |
6575 |
|
if (SCHARS (start) != SBYTES (start)) |
6576 |
|
non_ascii_p = 1; |
6577 |
|
} |
6578 |
|
else |
6579 |
|
{ |
6580 |
|
int from, to, stop; |
6581 |
|
|
6582 |
|
CHECK_NUMBER_COERCE_MARKER (start); |
6583 |
|
CHECK_NUMBER_COERCE_MARKER (end); |
6584 |
|
if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) |
6585 |
|
args_out_of_range (start, end); |
6586 |
|
if (NILP (current_buffer->enable_multibyte_characters)) |
6587 |
|
return Qt; |
6588 |
|
from = CHAR_TO_BYTE (XINT (start)); |
6589 |
|
to = CHAR_TO_BYTE (XINT (end)); |
6590 |
|
stop = from < GPT_BYTE && GPT_BYTE < to ? GPT_BYTE : to; |
6591 |
|
p1 = BYTE_POS_ADDR (from), p1end = p1 + (stop - from); |
6592 |
|
if (stop == to) |
6593 |
|
p2 = p2end = p1end; |
6594 |
|
else |
6595 |
|
p2 = BYTE_POS_ADDR (stop), p2end = p2 + (to - stop); |
6596 |
|
if (XINT (end) - XINT (start) != to - from) |
6597 |
|
non_ascii_p = 1; |
6598 |
|
} |
6599 |
|
|
6600 |
|
if (!non_ascii_p) |
6601 |
|
{ |
6602 |
|
/* We are sure that the text contains no multibyte character. |
6603 |
|
Check if it contains eight-bit-graphic. */ |
6604 |
|
p = p1; |
6605 |
|
for (p = p1; p < p1end && ASCII_BYTE_P (*p); p++); |
6606 |
|
if (p == p1end) |
6607 |
|
{ |
6608 |
|
for (p = p2; p < p2end && ASCII_BYTE_P (*p); p++); |
6609 |
|
if (p == p2end) |
6610 |
|
return Qt; |
6611 |
|
} |
6612 |
|
} |
6613 |
|
|
6614 |
|
/* The text contains non-ASCII characters. */ |
6615 |
|
|
6616 |
|
work_table = Fmake_char_table (Qchar_coding_system, Qnil); |
6617 |
|
safe_codings = Fcopy_sequence (XCDR (Vcoding_system_safe_chars)); |
6618 |
|
|
6619 |
|
safe_codings = find_safe_codings_2 (p1, p1end, safe_codings, work_table, |
6620 |
|
&single_byte_char_found); |
6621 |
|
if (p2 < p2end) |
6622 |
|
safe_codings = find_safe_codings_2 (p2, p2end, safe_codings, work_table, |
6623 |
|
&single_byte_char_found); |
6624 |
|
if (EQ (safe_codings, XCDR (Vcoding_system_safe_chars))) |
6625 |
|
safe_codings = Qt; |
6626 |
|
else |
6627 |
|
{ |
6628 |
|
/* Turn safe_codings to a list of coding systems... */ |
6629 |
|
Lisp_Object val; |
6630 |
|
|
6631 |
|
if (single_byte_char_found) |
6632 |
|
/* ... and append these for eight-bit chars. */ |
6633 |
|
val = Fcons (Qraw_text, |
6634 |
|
Fcons (Qemacs_mule, Fcons (Qno_conversion, Qnil))); |
6635 |
|
else |
6636 |
|
/* ... and append generic coding systems. */ |
6637 |
|
val = Fcopy_sequence (XCAR (Vcoding_system_safe_chars)); |
6638 |
|
|
6639 |
|
for (; CONSP (safe_codings); safe_codings = XCDR (safe_codings)) |
6640 |
|
val = Fcons (XCAR (XCAR (safe_codings)), val); |
6641 |
|
safe_codings = val; |
6642 |
|
} |
6643 |
|
|
6644 |
|
return safe_codings; |
6645 |
|
} |
6646 |
|
|
6647 |
|
|
6648 |
/* Search from position POS for such characters that are unencodable |
/* Search from position POS for such characters that are unencodable |
6649 |
accoding to SAFE_CHARS, and return a list of their positions. P |
accoding to SAFE_CHARS, and return a list of their positions. P |
6650 |
points where in the memory the character at POS exists. Limit the |
points where in the memory the character at POS exists. Limit the |
6759 |
if (coding.type == coding_type_undecided) |
if (coding.type == coding_type_undecided) |
6760 |
safe_chars = Qnil; |
safe_chars = Qnil; |
6761 |
else |
else |
6762 |
safe_chars = coding_safe_chars (&coding); |
safe_chars = coding_safe_chars (coding_system); |
6763 |
|
|
6764 |
if (STRINGP (string) |
if (STRINGP (string) |
6765 |
|| from >= GPT || to <= GPT) |
|| from >= GPT || to <= GPT) |
7277 |
return Qnil; |
return Qnil; |
7278 |
} |
} |
7279 |
|
|
7280 |
|
DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal, |
7281 |
|
Sdefine_coding_system_internal, 1, 1, 0, |
7282 |
|
doc: /* Register CODING-SYSTEM as a base coding system. |
7283 |
|
This function is internal use only. */) |
7284 |
|
(coding_system) |
7285 |
|
Lisp_Object coding_system; |
7286 |
|
{ |
7287 |
|
Lisp_Object safe_chars, slot; |
7288 |
|
|
7289 |
|
if (NILP (Fcheck_coding_system (coding_system))) |
7290 |
|
Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
7291 |
|
safe_chars = coding_safe_chars (coding_system); |
7292 |
|
if (! EQ (safe_chars, Qt) && ! CHAR_TABLE_P (safe_chars)) |
7293 |
|
error ("No valid safe-chars property for %s", |
7294 |
|
SDATA (SYMBOL_NAME (coding_system))); |
7295 |
|
if (EQ (safe_chars, Qt)) |
7296 |
|
{ |
7297 |
|
if (NILP (Fmemq (coding_system, XCAR (Vcoding_system_safe_chars)))) |
7298 |
|
XSETCAR (Vcoding_system_safe_chars, |
7299 |
|
Fcons (coding_system, XCAR (Vcoding_system_safe_chars))); |
7300 |
|
} |
7301 |
|
else |
7302 |
|
{ |
7303 |
|
slot = Fassq (coding_system, XCDR (Vcoding_system_safe_chars)); |
7304 |
|
if (NILP (slot)) |
7305 |
|
XSETCDR (Vcoding_system_safe_chars, |
7306 |
|
nconc2 (XCDR (Vcoding_system_safe_chars), |
7307 |
|
Fcons (Fcons (coding_system, safe_chars), Qnil))); |
7308 |
|
else |
7309 |
|
XSETCDR (slot, safe_chars); |
7310 |
|
} |
7311 |
|
return Qnil; |
7312 |
|
} |
7313 |
|
|
7314 |
#endif /* emacs */ |
#endif /* emacs */ |
7315 |
|
|
7316 |
|
|
7464 |
} |
} |
7465 |
} |
} |
7466 |
|
|
7467 |
|
Vcoding_system_safe_chars = Fcons (Qnil, Qnil); |
7468 |
|
staticpro (&Vcoding_system_safe_chars); |
7469 |
|
|
7470 |
Qtranslation_table = intern ("translation-table"); |
Qtranslation_table = intern ("translation-table"); |
7471 |
staticpro (&Qtranslation_table); |
staticpro (&Qtranslation_table); |
7472 |
Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (1)); |
Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (1)); |
7509 |
defsubr (&Sdetect_coding_region); |
defsubr (&Sdetect_coding_region); |
7510 |
defsubr (&Sdetect_coding_string); |
defsubr (&Sdetect_coding_string); |
7511 |
defsubr (&Sfind_coding_systems_region_internal); |
defsubr (&Sfind_coding_systems_region_internal); |
7512 |
|
defsubr (&Sfind_coding_systems_region_internal_2); |
7513 |
defsubr (&Sunencodable_char_position); |
defsubr (&Sunencodable_char_position); |
7514 |
defsubr (&Sdecode_coding_region); |
defsubr (&Sdecode_coding_region); |
7515 |
defsubr (&Sencode_coding_region); |
defsubr (&Sencode_coding_region); |
7527 |
defsubr (&Sfind_operation_coding_system); |
defsubr (&Sfind_operation_coding_system); |
7528 |
defsubr (&Supdate_coding_systems_internal); |
defsubr (&Supdate_coding_systems_internal); |
7529 |
defsubr (&Sset_coding_priority_internal); |
defsubr (&Sset_coding_priority_internal); |
7530 |
|
defsubr (&Sdefine_coding_system_internal); |
7531 |
|
|
7532 |
DEFVAR_LISP ("coding-system-list", &Vcoding_system_list, |
DEFVAR_LISP ("coding-system-list", &Vcoding_system_list, |
7533 |
doc: /* List of coding systems. |
doc: /* List of coding systems. |
7725 |
DEFVAR_BOOL ("coding-system-require-warning", |
DEFVAR_BOOL ("coding-system-require-warning", |
7726 |
&coding_system_require_warning, |
&coding_system_require_warning, |
7727 |
doc: /* Internal use only. |
doc: /* Internal use only. |
7728 |
If non-nil, on writing a file, select-safe-coding-system-function is |
If non-nil, on writing a file, `select-safe-coding-system-function' is |
7729 |
called even if coding-system-for-write is non-nil. The command |
called even if `coding-system-for-write' is non-nil. The command |
7730 |
universal-coding-system-argument binds this variable to t temporarily. */); |
`universal-coding-system-argument' binds this variable to t temporarily. */); |
7731 |
coding_system_require_warning = 0; |
coding_system_require_warning = 0; |
7732 |
|
|
7733 |
|
|