From: Miles Bader Date: Tue, 24 Jul 2007 01:23:55 +0000 (+0000) Subject: Merge from emacs--devo--0 X-Git-Tag: emacs-pretest-23.0.90~8295^2~371 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d918f936d5bfc7e126cc3b1bbf6ce80836c8d6f1;p=emacs.git Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 816-823) - Update from CVS - Merge from emacs--rel--22 * emacs--rel--22 (patch 59-69) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 237-238) - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-235 --- d918f936d5bfc7e126cc3b1bbf6ce80836c8d6f1 diff --cc src/coding.c index e4ecbf50f62,ad9536ec8c6..59592fdd09d --- a/src/coding.c +++ b/src/coding.c @@@ -8373,698 -7447,137 +8373,698 @@@ The first argument OPERATION specifies For process I/O, `call-process', `call-process-region', or `start-process'. For network I/O, `open-network-stream'. -The remaining arguments should be the same arguments that were passed -to the primitive. Depending on which primitive, one of those arguments -is selected as the TARGET. For example, if OPERATION does file I/O, -whichever argument specifies the file name is TARGET. +The remaining arguments should be the same arguments that were passed +to the primitive. Depending on which primitive, one of those arguments +is selected as the TARGET. For example, if OPERATION does file I/O, +whichever argument specifies the file name is TARGET. + +TARGET has a meaning which depends on OPERATION: + For file I/O, TARGET is a file name (except for the special case below). + For process I/O, TARGET is a process name. + For network I/O, TARGET is a service name or a port number + +This function looks up what specified for TARGET in, +`file-coding-system-alist', `process-coding-system-alist', +or `network-coding-system-alist' depending on OPERATION. +They may specify a coding system, a cons of coding systems, +or a function symbol to call. +In the last case, we call the function with one argument, +which is a list of all the arguments given to this function. +If the function can't decide a coding system, it can return +`undecided' so that the normal code-detection is performed. + +If OPERATION is `insert-file-contents', the argument corresponding to +TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a +file name to look up, and BUFFER is a buffer that contains the file's +contents (not yet decoded). If `file-coding-system-alist' specifies a +function to call for FILENAME, that function should examine the +contents of BUFFER instead of reading the file. + - usage: (find-operation-coding-system OPERATION ARGUMENTS ...) */) ++usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object operation, target_idx, target, val; + register Lisp_Object chain; + + if (nargs < 2) + error ("Too few arguments"); + operation = args[0]; + if (!SYMBOLP (operation) + || !INTEGERP (target_idx = Fget (operation, Qtarget_idx))) + error ("Invalid first arguement"); + if (nargs < 1 + XINT (target_idx)) + error ("Too few arguments for operation: %s", + SDATA (SYMBOL_NAME (operation))); + target = args[XINT (target_idx) + 1]; + if (!(STRINGP (target) + || (EQ (operation, Qinsert_file_contents) && CONSP (target) + && STRINGP (XCAR (target)) && BUFFERP (XCDR (target))) + || (EQ (operation, Qopen_network_stream) && INTEGERP (target)))) + error ("Invalid %dth argument", XINT (target_idx) + 1); + if (CONSP (target)) + target = XCAR (target); + + chain = ((EQ (operation, Qinsert_file_contents) + || EQ (operation, Qwrite_region)) + ? Vfile_coding_system_alist + : (EQ (operation, Qopen_network_stream) + ? Vnetwork_coding_system_alist + : Vprocess_coding_system_alist)); + if (NILP (chain)) + return Qnil; + + for (; CONSP (chain); chain = XCDR (chain)) + { + Lisp_Object elt; + + elt = XCAR (chain); + if (CONSP (elt) + && ((STRINGP (target) + && STRINGP (XCAR (elt)) + && fast_string_match (XCAR (elt), target) >= 0) + || (INTEGERP (target) && EQ (target, XCAR (elt))))) + { + val = XCDR (elt); + /* Here, if VAL is both a valid coding system and a valid + function symbol, we return VAL as a coding system. */ + if (CONSP (val)) + return val; + if (! SYMBOLP (val)) + return Qnil; + if (! NILP (Fcoding_system_p (val))) + return Fcons (val, val); + if (! NILP (Ffboundp (val))) + { + /* We use call1 rather than safe_call1 + so as to get bug reports about functions called here + which don't handle the current interface. */ + val = call1 (val, Flist (nargs, args)); + if (CONSP (val)) + return val; + if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val))) + return Fcons (val, val); + } + return Qnil; + } + } + return Qnil; +} + +DEFUN ("set-coding-system-priority", Fset_coding_system_priority, + Sset_coding_system_priority, 0, MANY, 0, + doc: /* Assign higher priority to the coding systems given as arguments. +If multiple coding systems belongs to the same category, +all but the first one are ignored. + +usage: (set-coding-system-priority ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + int i, j; + int changed[coding_category_max]; + enum coding_category priorities[coding_category_max]; + + bzero (changed, sizeof changed); + + for (i = j = 0; i < nargs; i++) + { + enum coding_category category; + Lisp_Object spec, attrs; + + CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec); + attrs = AREF (spec, 0); + category = XINT (CODING_ATTR_CATEGORY (attrs)); + if (changed[category]) + /* Ignore this coding system because a coding system of the + same category already had a higher priority. */ + continue; + changed[category] = 1; + priorities[j++] = category; + if (coding_categories[category].id >= 0 + && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id))) + setup_coding_system (args[i], &coding_categories[category]); + Fset (AREF (Vcoding_category_table, category), args[i]); + } + + /* Now we have decided top J priorities. Reflect the order of the + original priorities to the remaining priorities. */ + + for (i = j, j = 0; i < coding_category_max; i++, j++) + { + while (j < coding_category_max + && changed[coding_priorities[j]]) + j++; + if (j == coding_category_max) + abort (); + priorities[i] = coding_priorities[j]; + } + + bcopy (priorities, coding_priorities, sizeof priorities); + + /* Update `coding-category-list'. */ + Vcoding_category_list = Qnil; + for (i = coding_category_max - 1; i >= 0; i--) + Vcoding_category_list + = Fcons (AREF (Vcoding_category_table, priorities[i]), + Vcoding_category_list); + + return Qnil; +} + +DEFUN ("coding-system-priority-list", Fcoding_system_priority_list, + Scoding_system_priority_list, 0, 1, 0, + doc: /* Return a list of coding systems ordered by their priorities. +HIGHESTP non-nil means just return the highest priority one. */) + (highestp) + Lisp_Object highestp; +{ + int i; + Lisp_Object val; + + for (i = 0, val = Qnil; i < coding_category_max; i++) + { + enum coding_category category = coding_priorities[i]; + int id = coding_categories[category].id; + Lisp_Object attrs; + + if (id < 0) + continue; + attrs = CODING_ID_ATTRS (id); + if (! NILP (highestp)) + return CODING_ATTR_BASE_NAME (attrs); + val = Fcons (CODING_ATTR_BASE_NAME (attrs), val); + } + return Fnreverse (val); +} + +static char *suffixes[] = { "-unix", "-dos", "-mac" }; + +static Lisp_Object +make_subsidiaries (base) + Lisp_Object base; +{ + Lisp_Object subsidiaries; + int base_name_len = SBYTES (SYMBOL_NAME (base)); + char *buf = (char *) alloca (base_name_len + 6); + int i; + + bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len); + subsidiaries = Fmake_vector (make_number (3), Qnil); + for (i = 0; i < 3; i++) + { + bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1); + ASET (subsidiaries, i, intern (buf)); + } + return subsidiaries; +} + + +DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal, + Sdefine_coding_system_internal, coding_arg_max, MANY, 0, + doc: /* For internal use only. +usage: (define-coding-system-internal ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object name; + Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */ + Lisp_Object attrs; /* Vector of attributes. */ + Lisp_Object eol_type; + Lisp_Object aliases; + Lisp_Object coding_type, charset_list, safe_charsets; + enum coding_category category; + Lisp_Object tail, val; + int max_charset_id = 0; + int i; + + if (nargs < coding_arg_max) + goto short_args; + + attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil); + + name = args[coding_arg_name]; + CHECK_SYMBOL (name); + CODING_ATTR_BASE_NAME (attrs) = name; + + val = args[coding_arg_mnemonic]; + if (! STRINGP (val)) + CHECK_CHARACTER (val); + CODING_ATTR_MNEMONIC (attrs) = val; + + coding_type = args[coding_arg_coding_type]; + CHECK_SYMBOL (coding_type); + CODING_ATTR_TYPE (attrs) = coding_type; + + charset_list = args[coding_arg_charset_list]; + if (SYMBOLP (charset_list)) + { + if (EQ (charset_list, Qiso_2022)) + { + if (! EQ (coding_type, Qiso_2022)) + error ("Invalid charset-list"); + charset_list = Viso_2022_charset_list; + } + else if (EQ (charset_list, Qemacs_mule)) + { + if (! EQ (coding_type, Qemacs_mule)) + error ("Invalid charset-list"); + charset_list = Vemacs_mule_charset_list; + } + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + if (max_charset_id < XFASTINT (XCAR (tail))) + max_charset_id = XFASTINT (XCAR (tail)); + } + else + { + charset_list = Fcopy_sequence (charset_list); + for (tail = charset_list; !NILP (tail); tail = Fcdr (tail)) + { + struct charset *charset; + + val = Fcar (tail); + CHECK_CHARSET_GET_CHARSET (val, charset); + if (EQ (coding_type, Qiso_2022) + ? CHARSET_ISO_FINAL (charset) < 0 + : EQ (coding_type, Qemacs_mule) + ? CHARSET_EMACS_MULE_ID (charset) < 0 + : 0) + error ("Can't handle charset `%s'", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + XSETCAR (tail, make_number (charset->id)); + if (max_charset_id < charset->id) + max_charset_id = charset->id; + } + } + CODING_ATTR_CHARSET_LIST (attrs) = charset_list; + + safe_charsets = Fmake_string (make_number (max_charset_id + 1), + make_number (255)); + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); + CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets; + + CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p]; + + val = args[coding_arg_decode_translation_table]; + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_DECODE_TBL (attrs) = val; + + val = args[coding_arg_encode_translation_table]; + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_ENCODE_TBL (attrs) = val; + + val = args[coding_arg_post_read_conversion]; + CHECK_SYMBOL (val); + CODING_ATTR_POST_READ (attrs) = val; + + val = args[coding_arg_pre_write_conversion]; + CHECK_SYMBOL (val); + CODING_ATTR_PRE_WRITE (attrs) = val; + + val = args[coding_arg_default_char]; + if (NILP (val)) + CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' '); + else + { + CHECK_CHARACTER (val); + CODING_ATTR_DEFAULT_CHAR (attrs) = val; + } + + val = args[coding_arg_for_unibyte]; + CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt; + + val = args[coding_arg_plist]; + CHECK_LIST (val); + CODING_ATTR_PLIST (attrs) = val; + + if (EQ (coding_type, Qcharset)) + { + /* Generate a lisp vector of 256 elements. Each element is nil, + integer, or a list of charset IDs. + + If Nth element is nil, the byte code N is invalid in this + coding system. + + If Nth element is a number NUM, N is the first byte of a + charset whose ID is NUM. + + If Nth element is a list of charset IDs, N is the first byte + of one of them. The list is sorted by dimensions of the + charsets. A charset of smaller dimension comes firtst. */ + val = Fmake_vector (make_number (256), Qnil); + + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + { + struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail))); + int dim = CHARSET_DIMENSION (charset); + int idx = (dim - 1) * 4; + + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + for (i = charset->code_space[idx]; + i <= charset->code_space[idx + 1]; i++) + { + Lisp_Object tmp, tmp2; + int dim2; + + tmp = AREF (val, i); + if (NILP (tmp)) + tmp = XCAR (tail); + else if (NUMBERP (tmp)) + { + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp))); + if (dim < dim2) + tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil)); + else + tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil)); + } + else + { + for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2)) + { + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2)))); + if (dim < dim2) + break; + } + if (NILP (tmp2)) + tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil)); + else + { + XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2))); + XSETCAR (tmp2, XCAR (tail)); + } + } + ASET (val, i, tmp); + } + } + ASET (attrs, coding_attr_charset_valids, val); + category = coding_category_charset; + } + else if (EQ (coding_type, Qccl)) + { + Lisp_Object valids; + + if (nargs < coding_arg_ccl_max) + goto short_args; + + val = args[coding_arg_ccl_decoder]; + CHECK_CCL_PROGRAM (val); + if (VECTORP (val)) + val = Fcopy_sequence (val); + ASET (attrs, coding_attr_ccl_decoder, val); + + val = args[coding_arg_ccl_encoder]; + CHECK_CCL_PROGRAM (val); + if (VECTORP (val)) + val = Fcopy_sequence (val); + ASET (attrs, coding_attr_ccl_encoder, val); -TARGET has a meaning which depends on OPERATION: - For file I/O, TARGET is a file name (except for the special case below). - For process I/O, TARGET is a process name. - For network I/O, TARGET is a service name or a port number + val = args[coding_arg_ccl_valids]; + valids = Fmake_string (make_number (256), make_number (0)); + for (tail = val; !NILP (tail); tail = Fcdr (tail)) + { + int from, to; -This function looks up what specified for TARGET in, -`file-coding-system-alist', `process-coding-system-alist', -or `network-coding-system-alist' depending on OPERATION. -They may specify a coding system, a cons of coding systems, -or a function symbol to call. -In the last case, we call the function with one argument, -which is a list of all the arguments given to this function. -If the function can't decide a coding system, it can return -`undecided' so that the normal code-detection is performed. + val = Fcar (tail); + if (INTEGERP (val)) + { + from = to = XINT (val); + if (from < 0 || from > 255) + args_out_of_range_3 (val, make_number (0), make_number (255)); + } + else + { + CHECK_CONS (val); + CHECK_NATNUM_CAR (val); + CHECK_NATNUM_CDR (val); + from = XINT (XCAR (val)); + if (from > 255) + args_out_of_range_3 (XCAR (val), + make_number (0), make_number (255)); + to = XINT (XCDR (val)); + if (to < from || to > 255) + args_out_of_range_3 (XCDR (val), + XCAR (val), make_number (255)); + } + for (i = from; i <= to; i++) + SSET (valids, i, 1); + } + ASET (attrs, coding_attr_ccl_valids, valids); -If OPERATION is `insert-file-contents', the argument corresponding to -TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a -file name to look up, and BUFFER is a buffer that contains the file's -contents (not yet decoded). If `file-coding-system-alist' specifies a -function to call for FILENAME, that function should examine the -contents of BUFFER instead of reading the file. + category = coding_category_ccl; + } + else if (EQ (coding_type, Qutf_16)) + { + Lisp_Object bom, endian; -usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) - (nargs, args) - int nargs; - Lisp_Object *args; -{ - Lisp_Object operation, target_idx, target, val; - register Lisp_Object chain; + CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; - if (nargs < 2) - error ("Too few arguments"); - operation = args[0]; - if (!SYMBOLP (operation) - || !INTEGERP (target_idx = Fget (operation, Qtarget_idx))) - error ("Invalid first argument"); - if (nargs < 1 + XINT (target_idx)) - error ("Too few arguments for operation: %s", - SDATA (SYMBOL_NAME (operation))); - /* For write-region, if the 6th argument (i.e. VISIT, the 5th - argument to write-region) is string, it must be treated as a - target file name. */ - if (EQ (operation, Qwrite_region) - && nargs > 5 - && STRINGP (args[5])) - target_idx = make_number (4); - target = args[XINT (target_idx) + 1]; - if (!(STRINGP (target) - || (EQ (operation, Qinsert_file_contents) && CONSP (target) - && STRINGP (XCAR (target)) && BUFFERP (XCDR (target))) - || (EQ (operation, Qopen_network_stream) && INTEGERP (target)))) - error ("Invalid argument %d", XINT (target_idx) + 1); - if (CONSP (target)) - target = XCAR (target); + if (nargs < coding_arg_utf16_max) + goto short_args; - chain = ((EQ (operation, Qinsert_file_contents) - || EQ (operation, Qwrite_region)) - ? Vfile_coding_system_alist - : (EQ (operation, Qopen_network_stream) - ? Vnetwork_coding_system_alist - : Vprocess_coding_system_alist)); - if (NILP (chain)) - return Qnil; + bom = args[coding_arg_utf16_bom]; + if (! NILP (bom) && ! EQ (bom, Qt)) + { + CHECK_CONS (bom); + val = XCAR (bom); + CHECK_CODING_SYSTEM (val); + val = XCDR (bom); + CHECK_CODING_SYSTEM (val); + } + ASET (attrs, coding_attr_utf_16_bom, bom); + + endian = args[coding_arg_utf16_endian]; + CHECK_SYMBOL (endian); + if (NILP (endian)) + endian = Qbig; + else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle)) + error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian))); + ASET (attrs, coding_attr_utf_16_endian, endian); + + category = (CONSP (bom) + ? coding_category_utf_16_auto + : NILP (bom) + ? (EQ (endian, Qbig) + ? coding_category_utf_16_be_nosig + : coding_category_utf_16_le_nosig) + : (EQ (endian, Qbig) + ? coding_category_utf_16_be + : coding_category_utf_16_le)); + } + else if (EQ (coding_type, Qiso_2022)) + { + Lisp_Object initial, reg_usage, request, flags; + int i; - for (; CONSP (chain); chain = XCDR (chain)) - { - Lisp_Object elt; - elt = XCAR (chain); + if (nargs < coding_arg_iso2022_max) + goto short_args; - if (CONSP (elt) - && ((STRINGP (target) - && STRINGP (XCAR (elt)) - && fast_string_match (XCAR (elt), target) >= 0) - || (INTEGERP (target) && EQ (target, XCAR (elt))))) + initial = Fcopy_sequence (args[coding_arg_iso2022_initial]); + CHECK_VECTOR (initial); + for (i = 0; i < 4; i++) { - val = XCDR (elt); - /* Here, if VAL is both a valid coding system and a valid - function symbol, we return VAL as a coding system. */ - if (CONSP (val)) - return val; - if (! SYMBOLP (val)) - return Qnil; - if (! NILP (Fcoding_system_p (val))) - return Fcons (val, val); - if (! NILP (Ffboundp (val))) + val = Faref (initial, make_number (i)); + if (! NILP (val)) { - /* We use call1 rather than safe_call1 - so as to get bug reports about functions called here - which don't handle the current interface. */ - val = call1 (val, Flist (nargs, args)); - if (CONSP (val)) - return val; - if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val))) - return Fcons (val, val); + struct charset *charset; + + CHECK_CHARSET_GET_CHARSET (val, charset); + ASET (initial, i, make_number (CHARSET_ID (charset))); + if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; } - return Qnil; + else + ASET (initial, i, make_number (-1)); } - } - return Qnil; -} -DEFUN ("update-coding-systems-internal", Fupdate_coding_systems_internal, - Supdate_coding_systems_internal, 0, 0, 0, - doc: /* Update internal database for ISO2022 and CCL based coding systems. -When values of any coding categories are changed, you must -call this function. */) - () -{ - int i; + reg_usage = args[coding_arg_iso2022_reg_usage]; + CHECK_CONS (reg_usage); + CHECK_NUMBER_CAR (reg_usage); + CHECK_NUMBER_CDR (reg_usage); + + request = Fcopy_sequence (args[coding_arg_iso2022_request]); + for (tail = request; ! NILP (tail); tail = Fcdr (tail)) + { + int id; + Lisp_Object tmp; + + val = Fcar (tail); + CHECK_CONS (val); + tmp = XCAR (val); + CHECK_CHARSET_GET_ID (tmp, id); + CHECK_NATNUM_CDR (val); + if (XINT (XCDR (val)) >= 4) + error ("Invalid graphic register number: %d", XINT (XCDR (val))); + XSETCAR (val, make_number (id)); + } - for (i = CODING_CATEGORY_IDX_EMACS_MULE; i < CODING_CATEGORY_IDX_MAX; i++) + flags = args[coding_arg_iso2022_flags]; + CHECK_NATNUM (flags); + i = XINT (flags); + if (EQ (args[coding_arg_charset_list], Qiso_2022)) + flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT); + + ASET (attrs, coding_attr_iso_initial, initial); + ASET (attrs, coding_attr_iso_usage, reg_usage); + ASET (attrs, coding_attr_iso_request, request); + ASET (attrs, coding_attr_iso_flags, flags); + setup_iso_safe_charsets (attrs); + + if (i & CODING_ISO_FLAG_SEVEN_BITS) + category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT + | CODING_ISO_FLAG_SINGLE_SHIFT)) + ? coding_category_iso_7_else + : EQ (args[coding_arg_charset_list], Qiso_2022) + ? coding_category_iso_7 + : coding_category_iso_7_tight); + else + { + int id = XINT (AREF (initial, 1)); + + category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT) + || EQ (args[coding_arg_charset_list], Qiso_2022) + || id < 0) + ? coding_category_iso_8_else + : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1) + ? coding_category_iso_8_1 + : coding_category_iso_8_2); + } + if (category != coding_category_iso_8_1 + && category != coding_category_iso_8_2) + CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; + } + else if (EQ (coding_type, Qemacs_mule)) { - Lisp_Object val; + if (EQ (args[coding_arg_charset_list], Qemacs_mule)) + ASET (attrs, coding_attr_emacs_mule_full, Qt); + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + category = coding_category_emacs_mule; + } + else if (EQ (coding_type, Qshift_jis)) + { + + struct charset *charset; - val = SYMBOL_VALUE (XVECTOR (Vcoding_category_table)->contents[i]); - if (!NILP (val)) + if (XINT (Flength (charset_list)) != 3 + && XINT (Flength (charset_list)) != 4) + error ("There should be three or four charsets"); + + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + charset_list = XCDR (charset_list); + if (! NILP (charset_list)) { - 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]); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); } - else if (coding_system_table[i]) + + category = coding_category_sjis; + Vsjis_coding_system = name; + } + else if (EQ (coding_type, Qbig5)) + { + struct charset *charset; + + if (XINT (Flength (charset_list)) != 2) + error ("There should be just two charsets"); + + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + category = coding_category_big5; + Vbig5_coding_system = name; + } + else if (EQ (coding_type, Qraw_text)) + { + category = coding_category_raw_text; + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + } + else if (EQ (coding_type, Qutf_8)) + { + category = coding_category_utf_8; + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + } + else if (EQ (coding_type, Qundecided)) + category = coding_category_undecided; + else + error ("Invalid coding system type: %s", + SDATA (SYMBOL_NAME (coding_type))); + + CODING_ATTR_CATEGORY (attrs) = make_number (category); + CODING_ATTR_PLIST (attrs) + = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category), + CODING_ATTR_PLIST (attrs))); + CODING_ATTR_PLIST (attrs) + = Fcons (QCascii_compatible_p, + Fcons (CODING_ATTR_ASCII_COMPAT (attrs), + CODING_ATTR_PLIST (attrs))); + + eol_type = args[coding_arg_eol_type]; + if (! NILP (eol_type) + && ! EQ (eol_type, Qunix) + && ! EQ (eol_type, Qdos) + && ! EQ (eol_type, Qmac)) + error ("Invalid eol-type"); + + aliases = Fcons (name, Qnil); + + if (NILP (eol_type)) + { + eol_type = make_subsidiaries (name); + for (i = 0; i < 3; i++) { - xfree (coding_system_table[i]); - coding_system_table[i] = NULL; + Lisp_Object this_spec, this_name, this_aliases, this_eol_type; + + this_name = AREF (eol_type, i); + this_aliases = Fcons (this_name, Qnil); + this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac); + this_spec = Fmake_vector (make_number (3), attrs); + ASET (this_spec, 1, this_aliases); + ASET (this_spec, 2, this_eol_type); + Fputhash (this_name, this_spec, Vcoding_system_hash_table); + Vcoding_system_list = Fcons (this_name, Vcoding_system_list); + val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist); + if (NILP (val)) + Vcoding_system_alist + = Fcons (Fcons (Fsymbol_name (this_name), Qnil), + Vcoding_system_alist); } }