diff options
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 200 |
1 files changed, 23 insertions, 177 deletions
diff --git a/src/data.c b/src/data.c index 703e60b269b..6f1256786ec 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -26,7 +26,7 @@ Boston, MA 02110-1301, USA. */ | |||
| 26 | #include <stdio.h> | 26 | #include <stdio.h> |
| 27 | #include "lisp.h" | 27 | #include "lisp.h" |
| 28 | #include "puresize.h" | 28 | #include "puresize.h" |
| 29 | #include "charset.h" | 29 | #include "character.h" |
| 30 | #include "buffer.h" | 30 | #include "buffer.h" |
| 31 | #include "keyboard.h" | 31 | #include "keyboard.h" |
| 32 | #include "frame.h" | 32 | #include "frame.h" |
| @@ -117,7 +117,7 @@ wrong_type_argument (predicate, value) | |||
| 117 | { | 117 | { |
| 118 | /* If VALUE is not even a valid Lisp object, abort here | 118 | /* If VALUE is not even a valid Lisp object, abort here |
| 119 | where we can get a backtrace showing where it came from. */ | 119 | where we can get a backtrace showing where it came from. */ |
| 120 | if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) | 120 | if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) |
| 121 | abort (); | 121 | abort (); |
| 122 | 122 | ||
| 123 | xsignal2 (Qwrong_type_argument, predicate, value); | 123 | xsignal2 (Qwrong_type_argument, predicate, value); |
| @@ -189,7 +189,7 @@ for example, (type-of 1) returns `integer'. */) | |||
| 189 | (object) | 189 | (object) |
| 190 | Lisp_Object object; | 190 | Lisp_Object object; |
| 191 | { | 191 | { |
| 192 | switch (XGCTYPE (object)) | 192 | switch (XTYPE (object)) |
| 193 | { | 193 | { |
| 194 | case Lisp_Int: | 194 | case Lisp_Int: |
| 195 | return Qinteger; | 195 | return Qinteger; |
| @@ -216,25 +216,25 @@ for example, (type-of 1) returns `integer'. */) | |||
| 216 | abort (); | 216 | abort (); |
| 217 | 217 | ||
| 218 | case Lisp_Vectorlike: | 218 | case Lisp_Vectorlike: |
| 219 | if (GC_WINDOW_CONFIGURATIONP (object)) | 219 | if (WINDOW_CONFIGURATIONP (object)) |
| 220 | return Qwindow_configuration; | 220 | return Qwindow_configuration; |
| 221 | if (GC_PROCESSP (object)) | 221 | if (PROCESSP (object)) |
| 222 | return Qprocess; | 222 | return Qprocess; |
| 223 | if (GC_WINDOWP (object)) | 223 | if (WINDOWP (object)) |
| 224 | return Qwindow; | 224 | return Qwindow; |
| 225 | if (GC_SUBRP (object)) | 225 | if (SUBRP (object)) |
| 226 | return Qsubr; | 226 | return Qsubr; |
| 227 | if (GC_COMPILEDP (object)) | 227 | if (COMPILEDP (object)) |
| 228 | return Qcompiled_function; | 228 | return Qcompiled_function; |
| 229 | if (GC_BUFFERP (object)) | 229 | if (BUFFERP (object)) |
| 230 | return Qbuffer; | 230 | return Qbuffer; |
| 231 | if (GC_CHAR_TABLE_P (object)) | 231 | if (CHAR_TABLE_P (object)) |
| 232 | return Qchar_table; | 232 | return Qchar_table; |
| 233 | if (GC_BOOL_VECTOR_P (object)) | 233 | if (BOOL_VECTOR_P (object)) |
| 234 | return Qbool_vector; | 234 | return Qbool_vector; |
| 235 | if (GC_FRAMEP (object)) | 235 | if (FRAMEP (object)) |
| 236 | return Qframe; | 236 | return Qframe; |
| 237 | if (GC_HASH_TABLE_P (object)) | 237 | if (HASH_TABLE_P (object)) |
| 238 | return Qhash_table; | 238 | return Qhash_table; |
| 239 | return Qvector; | 239 | return Qvector; |
| 240 | 240 | ||
| @@ -437,11 +437,11 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, | |||
| 437 | } | 437 | } |
| 438 | 438 | ||
| 439 | DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, | 439 | DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, |
| 440 | doc: /* Return t if OBJECT is a character (an integer) or a string. */) | 440 | doc: /* Return t if OBJECT is a character or a string. */) |
| 441 | (object) | 441 | (object) |
| 442 | register Lisp_Object object; | 442 | register Lisp_Object object; |
| 443 | { | 443 | { |
| 444 | if (INTEGERP (object) || STRINGP (object)) | 444 | if (CHARACTERP (object) || STRINGP (object)) |
| 445 | return Qt; | 445 | return Qt; |
| 446 | return Qnil; | 446 | return Qnil; |
| 447 | } | 447 | } |
| @@ -1990,96 +1990,8 @@ or a byte-code object. IDX starts at 0. */) | |||
| 1990 | } | 1990 | } |
| 1991 | else if (CHAR_TABLE_P (array)) | 1991 | else if (CHAR_TABLE_P (array)) |
| 1992 | { | 1992 | { |
| 1993 | Lisp_Object val; | 1993 | CHECK_CHARACTER (idx); |
| 1994 | 1994 | return CHAR_TABLE_REF (array, idxval); | |
| 1995 | val = Qnil; | ||
| 1996 | |||
| 1997 | if (idxval < 0) | ||
| 1998 | args_out_of_range (array, idx); | ||
| 1999 | if (idxval < CHAR_TABLE_ORDINARY_SLOTS) | ||
| 2000 | { | ||
| 2001 | if (! SINGLE_BYTE_CHAR_P (idxval)) | ||
| 2002 | args_out_of_range (array, idx); | ||
| 2003 | /* For ASCII and 8-bit European characters, the element is | ||
| 2004 | stored in the top table. */ | ||
| 2005 | val = XCHAR_TABLE (array)->contents[idxval]; | ||
| 2006 | if (NILP (val)) | ||
| 2007 | { | ||
| 2008 | int default_slot | ||
| 2009 | = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII | ||
| 2010 | : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL | ||
| 2011 | : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); | ||
| 2012 | val = XCHAR_TABLE (array)->contents[default_slot]; | ||
| 2013 | } | ||
| 2014 | if (NILP (val)) | ||
| 2015 | val = XCHAR_TABLE (array)->defalt; | ||
| 2016 | while (NILP (val)) /* Follow parents until we find some value. */ | ||
| 2017 | { | ||
| 2018 | array = XCHAR_TABLE (array)->parent; | ||
| 2019 | if (NILP (array)) | ||
| 2020 | return Qnil; | ||
| 2021 | val = XCHAR_TABLE (array)->contents[idxval]; | ||
| 2022 | if (NILP (val)) | ||
| 2023 | val = XCHAR_TABLE (array)->defalt; | ||
| 2024 | } | ||
| 2025 | return val; | ||
| 2026 | } | ||
| 2027 | else | ||
| 2028 | { | ||
| 2029 | int code[4], i; | ||
| 2030 | Lisp_Object sub_table; | ||
| 2031 | Lisp_Object current_default; | ||
| 2032 | |||
| 2033 | SPLIT_CHAR (idxval, code[0], code[1], code[2]); | ||
| 2034 | if (code[1] < 32) code[1] = -1; | ||
| 2035 | else if (code[2] < 32) code[2] = -1; | ||
| 2036 | |||
| 2037 | /* Here, the possible range of CODE[0] (== charset ID) is | ||
| 2038 | 128..MAX_CHARSET. Since the top level char table contains | ||
| 2039 | data for multibyte characters after 256th element, we must | ||
| 2040 | increment CODE[0] by 128 to get a correct index. */ | ||
| 2041 | code[0] += 128; | ||
| 2042 | code[3] = -1; /* anchor */ | ||
| 2043 | |||
| 2044 | try_parent_char_table: | ||
| 2045 | current_default = XCHAR_TABLE (array)->defalt; | ||
| 2046 | sub_table = array; | ||
| 2047 | for (i = 0; code[i] >= 0; i++) | ||
| 2048 | { | ||
| 2049 | val = XCHAR_TABLE (sub_table)->contents[code[i]]; | ||
| 2050 | if (SUB_CHAR_TABLE_P (val)) | ||
| 2051 | { | ||
| 2052 | sub_table = val; | ||
| 2053 | if (! NILP (XCHAR_TABLE (sub_table)->defalt)) | ||
| 2054 | current_default = XCHAR_TABLE (sub_table)->defalt; | ||
| 2055 | } | ||
| 2056 | else | ||
| 2057 | { | ||
| 2058 | if (NILP (val)) | ||
| 2059 | val = current_default; | ||
| 2060 | if (NILP (val)) | ||
| 2061 | { | ||
| 2062 | array = XCHAR_TABLE (array)->parent; | ||
| 2063 | if (!NILP (array)) | ||
| 2064 | goto try_parent_char_table; | ||
| 2065 | } | ||
| 2066 | return val; | ||
| 2067 | } | ||
| 2068 | } | ||
| 2069 | /* Reaching here means IDXVAL is a generic character in | ||
| 2070 | which each character or a group has independent value. | ||
| 2071 | Essentially it's nonsense to get a value for such a | ||
| 2072 | generic character, but for backward compatibility, we try | ||
| 2073 | the default value and parent. */ | ||
| 2074 | val = current_default; | ||
| 2075 | if (NILP (val)) | ||
| 2076 | { | ||
| 2077 | array = XCHAR_TABLE (array)->parent; | ||
| 2078 | if (!NILP (array)) | ||
| 2079 | goto try_parent_char_table; | ||
| 2080 | } | ||
| 2081 | return val; | ||
| 2082 | } | ||
| 2083 | } | 1995 | } |
| 2084 | else | 1996 | else |
| 2085 | { | 1997 | { |
| @@ -2135,45 +2047,8 @@ bool-vector. IDX starts at 0. */) | |||
| 2135 | } | 2047 | } |
| 2136 | else if (CHAR_TABLE_P (array)) | 2048 | else if (CHAR_TABLE_P (array)) |
| 2137 | { | 2049 | { |
| 2138 | if (idxval < 0) | 2050 | CHECK_CHARACTER (idx); |
| 2139 | args_out_of_range (array, idx); | 2051 | CHAR_TABLE_SET (array, idxval, newelt); |
| 2140 | if (idxval < CHAR_TABLE_ORDINARY_SLOTS) | ||
| 2141 | { | ||
| 2142 | if (! SINGLE_BYTE_CHAR_P (idxval)) | ||
| 2143 | args_out_of_range (array, idx); | ||
| 2144 | XCHAR_TABLE (array)->contents[idxval] = newelt; | ||
| 2145 | } | ||
| 2146 | else | ||
| 2147 | { | ||
| 2148 | int code[4], i; | ||
| 2149 | Lisp_Object val; | ||
| 2150 | |||
| 2151 | SPLIT_CHAR (idxval, code[0], code[1], code[2]); | ||
| 2152 | if (code[1] < 32) code[1] = -1; | ||
| 2153 | else if (code[2] < 32) code[2] = -1; | ||
| 2154 | |||
| 2155 | /* See the comment of the corresponding part in Faref. */ | ||
| 2156 | code[0] += 128; | ||
| 2157 | code[3] = -1; /* anchor */ | ||
| 2158 | for (i = 0; code[i + 1] >= 0; i++) | ||
| 2159 | { | ||
| 2160 | val = XCHAR_TABLE (array)->contents[code[i]]; | ||
| 2161 | if (SUB_CHAR_TABLE_P (val)) | ||
| 2162 | array = val; | ||
| 2163 | else | ||
| 2164 | { | ||
| 2165 | Lisp_Object temp; | ||
| 2166 | |||
| 2167 | /* VAL is a leaf. Create a sub char table with the | ||
| 2168 | initial value VAL and look into it. */ | ||
| 2169 | |||
| 2170 | temp = make_sub_char_table (val); | ||
| 2171 | XCHAR_TABLE (array)->contents[code[i]] = temp; | ||
| 2172 | array = temp; | ||
| 2173 | } | ||
| 2174 | } | ||
| 2175 | XCHAR_TABLE (array)->contents[code[i]] = newelt; | ||
| 2176 | } | ||
| 2177 | } | 2052 | } |
| 2178 | else if (STRING_MULTIBYTE (array)) | 2053 | else if (STRING_MULTIBYTE (array)) |
| 2179 | { | 2054 | { |
| @@ -2182,7 +2057,7 @@ bool-vector. IDX starts at 0. */) | |||
| 2182 | 2057 | ||
| 2183 | if (idxval < 0 || idxval >= SCHARS (array)) | 2058 | if (idxval < 0 || idxval >= SCHARS (array)) |
| 2184 | args_out_of_range (array, idx); | 2059 | args_out_of_range (array, idx); |
| 2185 | CHECK_NUMBER (newelt); | 2060 | CHECK_CHARACTER (newelt); |
| 2186 | 2061 | ||
| 2187 | nbytes = SBYTES (array); | 2062 | nbytes = SBYTES (array); |
| 2188 | 2063 | ||
| @@ -2217,38 +2092,9 @@ bool-vector. IDX starts at 0. */) | |||
| 2217 | args_out_of_range (array, idx); | 2092 | args_out_of_range (array, idx); |
| 2218 | CHECK_NUMBER (newelt); | 2093 | CHECK_NUMBER (newelt); |
| 2219 | 2094 | ||
| 2220 | if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) | 2095 | if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt))) |
| 2221 | SSET (array, idxval, XINT (newelt)); | 2096 | args_out_of_range (array, newelt); |
| 2222 | else | 2097 | SSET (array, idxval, XINT (newelt)); |
| 2223 | { | ||
| 2224 | /* We must relocate the string data while converting it to | ||
| 2225 | multibyte. */ | ||
| 2226 | int idxval_byte, prev_bytes, new_bytes; | ||
| 2227 | unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; | ||
| 2228 | unsigned char *origstr = SDATA (array), *str; | ||
| 2229 | int nchars, nbytes; | ||
| 2230 | USE_SAFE_ALLOCA; | ||
| 2231 | |||
| 2232 | nchars = SCHARS (array); | ||
| 2233 | nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); | ||
| 2234 | nbytes += count_size_as_multibyte (origstr + idxval, | ||
| 2235 | nchars - idxval); | ||
| 2236 | SAFE_ALLOCA (str, unsigned char *, nbytes); | ||
| 2237 | copy_text (SDATA (array), str, nchars, 0, 1); | ||
| 2238 | PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, | ||
| 2239 | prev_bytes); | ||
| 2240 | new_bytes = CHAR_STRING (XINT (newelt), p0); | ||
| 2241 | allocate_string_data (XSTRING (array), nchars, | ||
| 2242 | nbytes + new_bytes - prev_bytes); | ||
| 2243 | bcopy (str, SDATA (array), idxval_byte); | ||
| 2244 | p1 = SDATA (array) + idxval_byte; | ||
| 2245 | while (new_bytes--) | ||
| 2246 | *p1++ = *p0++; | ||
| 2247 | bcopy (str + idxval_byte + prev_bytes, p1, | ||
| 2248 | nbytes - (idxval_byte + prev_bytes)); | ||
| 2249 | SAFE_FREE (); | ||
| 2250 | clear_string_char_byte_cache (); | ||
| 2251 | } | ||
| 2252 | } | 2098 | } |
| 2253 | 2099 | ||
| 2254 | return newelt; | 2100 | return newelt; |