(Qvalid_codes): New variable.

(coding_category_name): Include "coding-category-ccl".
(detect_coding_ccl): New function.
(setup_coding_system): Setup coding->spec.ccl.valid_codes from the
coding system priority `valid-codes' for CCL based coding systesm.
(detect_coding_mask): Check also a CCL based coding system.
(Fupdate_coding_systems_internal): Renamed from
Fupdate_iso_coding_systems.
(syms_of_coding): Change property char-table-extra-slot of
translation-table to 1.  Initialize and static pro Qvalid_codes.
This commit is contained in:
Kenichi Handa 1998-08-02 01:06:57 +00:00
parent 8469bb88e5
commit 1397dc18d5

View file

@ -25,10 +25,11 @@ Boston, MA 02111-1307, USA. */
2. Emacs' internal format (emacs-mule) handlers 2. Emacs' internal format (emacs-mule) handlers
3. ISO2022 handlers 3. ISO2022 handlers
4. Shift-JIS and BIG5 handlers 4. Shift-JIS and BIG5 handlers
5. End-of-line handlers 5. CCL handlers
6. C library functions 6. End-of-line handlers
7. Emacs Lisp library functions 7. C library functions
8. Post-amble 8. Emacs Lisp library functions
9. Post-amble
*/ */
@ -277,6 +278,7 @@ Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
Lisp_Object Qno_conversion, Qundecided; Lisp_Object Qno_conversion, Qundecided;
Lisp_Object Qcoding_system_history; Lisp_Object Qcoding_system_history;
Lisp_Object Qsafe_charsets; Lisp_Object Qsafe_charsets;
Lisp_Object Qvalid_codes;
extern Lisp_Object Qinsert_file_contents, Qwrite_region; extern Lisp_Object Qinsert_file_contents, Qwrite_region;
Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument; Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument;
@ -360,7 +362,8 @@ char *coding_category_name[CODING_CATEGORY_IDX_MAX] = {
"coding-category-iso-8-else", "coding-category-iso-8-else",
"coding-category-big5", "coding-category-big5",
"coding-category-raw-text", "coding-category-raw-text",
"coding-category-binary" "coding-category-binary",
"coding-category-ccl"
}; };
/* Table of pointers to coding systems corresponding to each coding /* Table of pointers to coding systems corresponding to each coding
@ -2451,7 +2454,34 @@ encode_coding_sjis_big5 (coding, source, destination,
} }
/*** 5. End-of-line handlers ***/ /*** 5. CCL handlers ***/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
Check if a text is encoded in a coding system of which
encoder/decoder are written in CCL program. If it is, return
CODING_CATEGORY_MASK_CCL, else return 0. */
int
detect_coding_ccl (src, src_end)
unsigned char *src, *src_end;
{
unsigned char *valid;
/* No coding system is assigned to coding-category-ccl. */
if (!coding_system_table[CODING_CATEGORY_IDX_CCL])
return 0;
valid = coding_system_table[CODING_CATEGORY_IDX_CCL]->spec.ccl.valid_codes;
while (src < src_end)
{
if (! valid[*src]) return 0;
src++;
}
return CODING_CATEGORY_MASK_CCL;
}
/*** 6. End-of-line handlers ***/
/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
This function is called only when `coding->eol_type' is This function is called only when `coding->eol_type' is
@ -2671,7 +2701,7 @@ encode_eol (coding, source, destination, src_bytes, dst_bytes)
} }
/*** 6. C library functions ***/ /*** 7. C library functions ***/
/* In Emacs Lisp, coding system is represented by a Lisp symbol which /* In Emacs Lisp, coding system is represented by a Lisp symbol which
has a property `coding-system'. The value of this property is a has a property `coding-system'. The value of this property is a
@ -3043,6 +3073,31 @@ setup_coding_system (coding_system, coding)
} }
else else
goto label_invalid_coding_system; goto label_invalid_coding_system;
bzero (coding->spec.ccl.valid_codes, 256);
val = Fplist_get (plist, Qvalid_codes);
if (CONSP (val))
{
Lisp_Object this;
for (this = XCONS (val)->car; CONSP (val); val = XCONS (val)->cdr)
{
if (INTEGERP (this)
&& XINT (this) >= 0 && XINT (this) < 256)
coding->spec.ccl.valid_codes[XINT (this)] = 1;
else if (CONSP (this)
&& INTEGERP (XCONS (this)->car)
&& INTEGERP (XCONS (this)->cdr))
{
int start = XINT (XCONS (this)->car);
int end = XINT (XCONS (this)->cdr);
if (start >= 0 && start <= end && end < 256)
while (start < end)
coding->spec.ccl.valid_codes[start++] = 1;
}
}
}
} }
coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK; coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK;
break; break;
@ -3158,6 +3213,12 @@ setup_raw_text_coding_system (coding)
as BIG5. Assigned the coding-system (Lisp symbol) as BIG5. Assigned the coding-system (Lisp symbol)
`cn-big5' by default. `cn-big5' by default.
o coding-category-ccl
The category for a coding system of which encoder/decoder is
written in CCL programs. The default value is nil, i.e., no
coding system is assigned.
o coding-category-binary o coding-category-binary
The category for a coding system not categorized in any of the The category for a coding system not categorized in any of the
@ -3264,6 +3325,12 @@ detect_coding_mask (source, src_bytes, priorities, skip)
| CODING_CATEGORY_MASK_SJIS | CODING_CATEGORY_MASK_SJIS
| CODING_CATEGORY_MASK_BIG5); | CODING_CATEGORY_MASK_BIG5);
/* Or, we may have to consider the possibility of CCL. */
if (coding_system_table[CODING_CATEGORY_IDX_CCL]
&& (coding_system_table[CODING_CATEGORY_IDX_CCL]
->spec.ccl.valid_codes)[c])
try |= CODING_CATEGORY_MASK_CCL;
mask = 0; mask = 0;
if (priorities) if (priorities)
{ {
@ -3277,6 +3344,8 @@ detect_coding_mask (source, src_bytes, priorities, skip)
mask = detect_coding_big5 (src, src_end); mask = detect_coding_big5 (src, src_end);
else if (priorities[i] & try & CODING_CATEGORY_MASK_EMACS_MULE) else if (priorities[i] & try & CODING_CATEGORY_MASK_EMACS_MULE)
mask = detect_coding_emacs_mule (src, src_end); mask = detect_coding_emacs_mule (src, src_end);
else if (priorities[i] & CODING_CATEGORY_MASK_CCL)
mask = detect_coding_ccl (src, src_end);
else if (priorities[i] & CODING_CATEGORY_MASK_RAW_TEXT) else if (priorities[i] & CODING_CATEGORY_MASK_RAW_TEXT)
mask = CODING_CATEGORY_MASK_RAW_TEXT; mask = CODING_CATEGORY_MASK_RAW_TEXT;
else if (priorities[i] & CODING_CATEGORY_MASK_BINARY) else if (priorities[i] & CODING_CATEGORY_MASK_BINARY)
@ -3293,7 +3362,9 @@ detect_coding_mask (source, src_bytes, priorities, skip)
if (try & CODING_CATEGORY_MASK_BIG5) if (try & CODING_CATEGORY_MASK_BIG5)
mask |= detect_coding_big5 (src, src_end); mask |= detect_coding_big5 (src, src_end);
if (try & CODING_CATEGORY_MASK_EMACS_MULE) if (try & CODING_CATEGORY_MASK_EMACS_MULE)
mask |= detect_coding_emacs_mule (src, src_end); mask |= detect_coding_emacs_mule (src, src_end);
if (try & CODING_CATEGORY_MASK_CCL)
mask |= detect_coding_ccl (src, src_end);
} }
return (mask | CODING_CATEGORY_MASK_RAW_TEXT | CODING_CATEGORY_MASK_BINARY); return (mask | CODING_CATEGORY_MASK_RAW_TEXT | CODING_CATEGORY_MASK_BINARY);
@ -4445,7 +4516,7 @@ code_convert_string (str, coding, encodep, nocopy)
#ifdef emacs #ifdef emacs
/*** 7. Emacs Lisp library functions ***/ /*** 8. Emacs Lisp library functions ***/
DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0, DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
"Return t if OBJECT is nil or a coding-system.\n\ "Return t if OBJECT is nil or a coding-system.\n\
@ -4979,28 +5050,38 @@ which is a list of all the arguments given to this function.")
return Qnil; return Qnil;
} }
DEFUN ("update-iso-coding-systems", Fupdate_iso_coding_systems, DEFUN ("update-coding-systems-internal", Fupdate_coding_systems_internal,
Supdate_iso_coding_systems, 0, 0, 0, Supdate_coding_systems_internal, 0, 0, 0,
"Update internal database for ISO2022 based coding systems.\n\ "Update internal database for ISO2022 and CCL based coding systems.\n\
When values of the following coding categories are changed, you must\n\ When values of the following coding categories are changed, you must\n\
call this function:\n\ call this function:\n\
coding-category-iso-7, coding-category-iso-7-tight,\n\ coding-category-iso-7, coding-category-iso-7-tight,\n\
coding-category-iso-8-1, coding-category-iso-8-2,\n\ coding-category-iso-8-1, coding-category-iso-8-2,\n\
coding-category-iso-7-else, coding-category-iso-8-else") coding-category-iso-7-else, coding-category-iso-8-else,\n\
coding-category-ccl")
() ()
{ {
int i; int i;
for (i = CODING_CATEGORY_IDX_ISO_7; i <= CODING_CATEGORY_IDX_ISO_8_ELSE; for (i = CODING_CATEGORY_IDX_ISO_7; i <= CODING_CATEGORY_IDX_CCL; i++)
i++)
{ {
if (! coding_system_table[i]) Lisp_Object val;
coding_system_table[i]
= (struct coding_system *) xmalloc (sizeof (struct coding_system)); val = XSYMBOL (XVECTOR (Vcoding_category_table)->contents[i])->value;
setup_coding_system if (!NILP (val))
(XSYMBOL (XVECTOR (Vcoding_category_table)->contents[i])->value, {
coding_system_table[i]); if (! coding_system_table[i])
coding_system_table[i] = ((struct coding_system *)
xmalloc (sizeof (struct coding_system)));
setup_coding_system (val, coding_system_table[i]);
}
else if (coding_system_table[i])
{
xfree (coding_system_table[i]);
coding_system_table[i] = NULL;
}
} }
return Qnil; return Qnil;
} }
@ -5035,7 +5116,7 @@ This function is internal use only.")
#endif /* emacs */ #endif /* emacs */
/*** 8. Post-amble ***/ /*** 9. Post-amble ***/
void void
init_coding () init_coding ()
@ -5193,7 +5274,7 @@ syms_of_coding ()
Qtranslation_table = intern ("translation-table"); Qtranslation_table = intern ("translation-table");
staticpro (&Qtranslation_table); staticpro (&Qtranslation_table);
Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (0)); Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (1));
Qtranslation_table_id = intern ("translation-table-id"); Qtranslation_table_id = intern ("translation-table-id");
staticpro (&Qtranslation_table_id); staticpro (&Qtranslation_table_id);
@ -5207,6 +5288,9 @@ syms_of_coding ()
Qsafe_charsets = intern ("safe-charsets"); Qsafe_charsets = intern ("safe-charsets");
staticpro (&Qsafe_charsets); staticpro (&Qsafe_charsets);
Qvalid_codes = intern ("valid-codes");
staticpro (&Qvalid_codes);
Qemacs_mule = intern ("emacs-mule"); Qemacs_mule = intern ("emacs-mule");
staticpro (&Qemacs_mule); staticpro (&Qemacs_mule);
@ -5233,7 +5317,7 @@ syms_of_coding ()
defsubr (&Sset_keyboard_coding_system_internal); defsubr (&Sset_keyboard_coding_system_internal);
defsubr (&Skeyboard_coding_system); defsubr (&Skeyboard_coding_system);
defsubr (&Sfind_operation_coding_system); defsubr (&Sfind_operation_coding_system);
defsubr (&Supdate_iso_coding_systems); defsubr (&Supdate_coding_systems_internal);
defsubr (&Sset_coding_priority_internal); defsubr (&Sset_coding_priority_internal);
DEFVAR_LISP ("coding-system-list", &Vcoding_system_list, DEFVAR_LISP ("coding-system-list", &Vcoding_system_list,