X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1f79789d4aea615815127596ccb7f3acc0db5c7f..10453be959b3656f9ed57336eab4e3ca77613304:/src/fns.c diff --git a/src/fns.c b/src/fns.c index 62f9d85682..fa99293fcc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1,5 +1,5 @@ /* Random utility Lisp functions. - Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001 + Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -26,15 +26,20 @@ Boston, MA 02111-1307, USA. */ #endif #include +#ifndef MAC_OSX +/* On Mac OS X, defining this conflicts with precompiled headers. */ + /* Note on some machines this defines `vector' as a typedef, so make sure we don't use that name in this file. */ #undef vector #define vector ***** +#endif /* ! MAC_OSX */ + #include "lisp.h" #include "commands.h" -#include "charset.h" - +#include "character.h" +#include "coding.h" #include "buffer.h" #include "keyboard.h" #include "keymap.h" @@ -47,7 +52,7 @@ Boston, MA 02111-1307, USA. */ #endif #ifndef NULL -#define NULL (void *)0 +#define NULL ((POINTER_TYPE *)0) #endif /* Nonzero enables use of dialog boxes for questions @@ -56,11 +61,13 @@ int use_dialog_box; extern int minibuffer_auto_raise; extern Lisp_Object minibuf_window; +extern Lisp_Object Vlocale_coding_system; Lisp_Object Qstring_lessp, Qprovide, Qrequire; Lisp_Object Qyes_or_no_p_history; Lisp_Object Qcursor_in_echo_area; Lisp_Object Qwidget_type; +Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; extern Lisp_Object Qinput_method_function; @@ -74,7 +81,7 @@ extern long time (); #endif DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, - doc: /* Return the argument unchanged. */) + doc: /* Return the argument unchanged. */) (arg) Lisp_Object arg; { @@ -121,7 +128,7 @@ With argument t, set the random number seed from the current time and pid. */) DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. -If the string contains multibyte characters, this is not the necessarily +If the string contains multibyte characters, this is not necessarily the number of bytes in the string; it is the number of characters. To get the number of bytes, use `string-bytes'. */) (sequence) @@ -132,7 +139,7 @@ To get the number of bytes, use `string-bytes'. */) retry: if (STRINGP (sequence)) - XSETFASTINT (val, XSTRING (sequence)->size); + XSETFASTINT (val, SCHARS (sequence)); else if (VECTORP (sequence)) XSETFASTINT (val, XVECTOR (sequence)->size); else if (CHAR_TABLE_P (sequence)) @@ -201,14 +208,14 @@ which is at least the number of distinct elements. */) return length; } -DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, +DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, doc: /* Return the number of bytes in STRING. If STRING is a multibyte string, this is greater than the length of STRING. */) (string) Lisp_Object string; { - CHECK_STRING (string, 1); - return make_number (STRING_BYTES (XSTRING (string))); + CHECK_STRING (string); + return make_number (SBYTES (string)); } DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, @@ -219,15 +226,15 @@ Symbols are also allowed; their print names are used instead. */) register Lisp_Object s1, s2; { if (SYMBOLP (s1)) - XSETSTRING (s1, XSYMBOL (s1)->name); + s1 = SYMBOL_NAME (s1); if (SYMBOLP (s2)) - XSETSTRING (s2, XSYMBOL (s2)->name); - CHECK_STRING (s1, 0); - CHECK_STRING (s2, 1); + s2 = SYMBOL_NAME (s2); + CHECK_STRING (s1); + CHECK_STRING (s2); - if (XSTRING (s1)->size != XSTRING (s2)->size - || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2)) - || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1)))) + if (SCHARS (s1) != SCHARS (s2) + || SBYTES (s1) != SBYTES (s2) + || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) return Qnil; return Qt; } @@ -253,18 +260,18 @@ If string STR1 is greater, the value is a positive number N; register int end1_char, end2_char; register int i1, i1_byte, i2, i2_byte; - CHECK_STRING (str1, 0); - CHECK_STRING (str2, 1); + CHECK_STRING (str1); + CHECK_STRING (str2); if (NILP (start1)) start1 = make_number (0); if (NILP (start2)) start2 = make_number (0); - CHECK_NATNUM (start1, 2); - CHECK_NATNUM (start2, 3); + CHECK_NATNUM (start1); + CHECK_NATNUM (start2); if (! NILP (end1)) - CHECK_NATNUM (end1, 4); + CHECK_NATNUM (end1); if (! NILP (end2)) - CHECK_NATNUM (end2, 4); + CHECK_NATNUM (end2); i1 = XINT (start1); i2 = XINT (start2); @@ -272,11 +279,11 @@ If string STR1 is greater, the value is a positive number N; i1_byte = string_char_to_byte (str1, i1); i2_byte = string_char_to_byte (str2, i2); - end1_char = XSTRING (str1)->size; + end1_char = SCHARS (str1); if (! NILP (end1) && end1_char > XINT (end1)) end1_char = XINT (end1); - end2_char = XSTRING (str2)->size; + end2_char = SCHARS (str2); if (! NILP (end2) && end2_char > XINT (end2)) end2_char = XINT (end2); @@ -290,7 +297,7 @@ If string STR1 is greater, the value is a positive number N; FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte); else { - c1 = XSTRING (str1)->data[i1++]; + c1 = SREF (str1, i1++); c1 = unibyte_char_to_multibyte (c1); } @@ -298,7 +305,7 @@ If string STR1 is greater, the value is a positive number N; FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte); else { - c2 = XSTRING (str2)->data[i2++]; + c2 = SREF (str2, i2++); c2 = unibyte_char_to_multibyte (c2); } @@ -346,17 +353,17 @@ Symbols are also allowed; their print names are used instead. */) register int i1, i1_byte, i2, i2_byte; if (SYMBOLP (s1)) - XSETSTRING (s1, XSYMBOL (s1)->name); + s1 = SYMBOL_NAME (s1); if (SYMBOLP (s2)) - XSETSTRING (s2, XSYMBOL (s2)->name); - CHECK_STRING (s1, 0); - CHECK_STRING (s2, 1); + s2 = SYMBOL_NAME (s2); + CHECK_STRING (s1); + CHECK_STRING (s2); i1 = i1_byte = i2 = i2_byte = 0; - end = XSTRING (s1)->size; - if (end > XSTRING (s2)->size) - end = XSTRING (s2)->size; + end = SCHARS (s1); + if (end > SCHARS (s2)) + end = SCHARS (s2); while (i1 < end) { @@ -370,7 +377,7 @@ Symbols are also allowed; their print names are used instead. */) if (c1 != c2) return c1 < c2 ? Qt : Qnil; } - return i1 < XSTRING (s2)->size ? Qt : Qnil; + return i1 < SCHARS (s2) ? Qt : Qnil; } static Lisp_Object concat (); @@ -443,30 +450,9 @@ usage: (vconcat &rest SEQUENCES) */) return concat (nargs, args, Lisp_Vectorlike, 0); } -/* Retrun a copy of a sub char table ARG. The elements except for a - nested sub char table are not copied. */ -static Lisp_Object -copy_sub_char_table (arg) - Lisp_Object arg; -{ - Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt); - int i; - - /* Copy all the contents. */ - bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents, - SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); - /* Recursively copy any sub char-tables in the ordinary slots. */ - for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++) - if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i])) - XCHAR_TABLE (copy)->contents[i] - = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]); - - return copy; -} - DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, - doc: /* Return a copy of a list, vector or string. + doc: /* Return a copy of a list, vector, string or char-table. The elements of a list or vector are not copied; they are shared with the original. */) (arg) @@ -476,24 +462,7 @@ with the original. */) if (CHAR_TABLE_P (arg)) { - int i; - Lisp_Object copy; - - copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil); - /* Copy all the slots, including the extra ones. */ - bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, - ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) - * sizeof (Lisp_Object))); - - /* Recursively copy any sub char tables in the ordinary slots - for multibyte characters. */ - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; - i < CHAR_TABLE_ORDINARY_SLOTS; i++) - if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i])) - XCHAR_TABLE (copy)->contents[i] - = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]); - - return copy; + return copy_char_table (arg); } if (BOOL_VECTOR_P (arg)) @@ -513,6 +482,7 @@ with the original. */) return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); } +#if 0 /* unused */ /* In string STR of length LEN, see if bytes before STR[I] combine with bytes after STR[I] to form a single character. If so, return the number of bytes after STR[I] which combine in this way. @@ -533,6 +503,7 @@ count_combining (str, len, i) PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes); return (bytes <= i - j ? 0 : bytes - (i - j)); } +#endif /* This structure holds information of an argument of `concat' that is a string and has text properties to be copied. */ @@ -616,11 +587,11 @@ concat (nargs, args, target_type, last_special) for (i = 0; i < len; i++) { ch = XVECTOR (this)->contents[i]; - if (! INTEGERP (ch)) - wrong_type_argument (Qintegerp, ch); + if (! CHARACTERP (ch)) + wrong_type_argument (Qcharacterp, ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; - if (!SINGLE_BYTE_CHAR_P (XINT (ch))) + if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) some_multibyte = 1; } else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0) @@ -629,11 +600,11 @@ concat (nargs, args, target_type, last_special) for (; CONSP (this); this = XCDR (this)) { ch = XCAR (this); - if (! INTEGERP (ch)) - wrong_type_argument (Qintegerp, ch); + if (! CHARACTERP (ch)) + wrong_type_argument (Qcharacterp, ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; - if (!SINGLE_BYTE_CHAR_P (XINT (ch))) + if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) some_multibyte = 1; } else if (STRINGP (this)) @@ -641,11 +612,11 @@ concat (nargs, args, target_type, last_special) if (STRING_MULTIBYTE (this)) { some_multibyte = 1; - result_len_byte += STRING_BYTES (XSTRING (this)); + result_len_byte += SBYTES (this); } else - result_len_byte += count_size_as_multibyte (XSTRING (this)->data, - XSTRING (this)->size); + result_len_byte += count_size_as_multibyte (SDATA (this), + SCHARS (this)); } } @@ -695,39 +666,31 @@ concat (nargs, args, target_type, last_special) if (STRINGP (this) && STRINGP (val) && STRING_MULTIBYTE (this) == some_multibyte) { - int thislen_byte = STRING_BYTES (XSTRING (this)); - int combined; - - bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte, - STRING_BYTES (XSTRING (this))); - combined = (some_multibyte && toindex_byte > 0 - ? count_combining (XSTRING (val)->data, - toindex_byte + thislen_byte, - toindex_byte) - : 0); - if (! NULL_INTERVAL_P (XSTRING (this)->intervals)) + int thislen_byte = SBYTES (this); + + bcopy (SDATA (this), SDATA (val) + toindex_byte, + SBYTES (this)); + if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) { textprops[num_textprops].argnum = argnum; - /* We ignore text properties on characters being combined. */ - textprops[num_textprops].from = combined; + textprops[num_textprops].from = 0; textprops[num_textprops++].to = toindex; } toindex_byte += thislen_byte; - toindex += thisleni - combined; - XSTRING (val)->size -= combined; + toindex += thisleni; } /* Copy a single-byte string to a multibyte string. */ else if (STRINGP (this) && STRINGP (val)) { - if (! NULL_INTERVAL_P (XSTRING (this)->intervals)) + if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) { textprops[num_textprops].argnum = argnum; textprops[num_textprops].from = 0; textprops[num_textprops++].to = toindex; } - toindex_byte += copy_text (XSTRING (this)->data, - XSTRING (val)->data + toindex_byte, - XSTRING (this)->size, 0, 1); + toindex_byte += copy_text (SDATA (this), + SDATA (val) + toindex_byte, + SCHARS (this), 0, 1); toindex += thisleni; } else @@ -755,11 +718,9 @@ concat (nargs, args, target_type, last_special) } else { - XSETFASTINT (elt, XSTRING (this)->data[thisindex++]); + XSETFASTINT (elt, SREF (this, thisindex++)); if (some_multibyte - && (XINT (elt) >= 0240 - || (XINT (elt) >= 0200 - && ! NILP (Vnonascii_translation_table))) + && XINT (elt) >= 0200 && XINT (elt) < 0400) { c = unibyte_char_to_multibyte (XINT (elt)); @@ -791,35 +752,13 @@ concat (nargs, args, target_type, last_special) XVECTOR (val)->contents[toindex++] = elt; else { - CHECK_NUMBER (elt, 0); - if (SINGLE_BYTE_CHAR_P (XINT (elt))) - { - if (some_multibyte) - toindex_byte - += CHAR_STRING (XINT (elt), - XSTRING (val)->data + toindex_byte); - else - XSTRING (val)->data[toindex_byte++] = XINT (elt); - if (some_multibyte - && toindex_byte > 0 - && count_combining (XSTRING (val)->data, - toindex_byte, toindex_byte - 1)) - XSTRING (val)->size--; - else - toindex++; - } + CHECK_NUMBER (elt); + if (some_multibyte) + toindex_byte += CHAR_STRING (XINT (elt), + SDATA (val) + toindex_byte); else - /* If we have any multibyte characters, - we already decided to make a multibyte string. */ - { - int c = XINT (elt); - /* P exists as a variable - to avoid a bug on the Masscomp C compiler. */ - unsigned char *p = & XSTRING (val)->data[toindex_byte]; - - toindex_byte += CHAR_STRING (c, p); - toindex++; - } + SSET (val, toindex_byte++, XINT (elt)); + toindex++; } } } @@ -836,7 +775,7 @@ concat (nargs, args, target_type, last_special) this = args[textprops[argnum].argnum]; props = text_property_list (this, make_number (0), - make_number (XSTRING (this)->size), + make_number (SCHARS (this)), Qnil); /* If successive arguments have properites, be sure that the value of `composition' property be the copy. */ @@ -844,7 +783,7 @@ concat (nargs, args, target_type, last_special) make_composition_value_copy (props); add_text_properties_from_list (val, props, make_number (textprops[argnum].to)); - last_to_end = textprops[argnum].to + XSTRING (this)->size; + last_to_end = textprops[argnum].to + SCHARS (this); } } return val; @@ -867,7 +806,7 @@ string_char_to_byte (string, char_index) Lisp_Object string; int char_index; { - int i, i_byte; + int i_byte; int best_below, best_below_byte; int best_above, best_above_byte; @@ -875,8 +814,8 @@ string_char_to_byte (string, char_index) return char_index; best_below = best_below_byte = 0; - best_above = XSTRING (string)->size; - best_above_byte = STRING_BYTES (XSTRING (string)); + best_above = SCHARS (string); + best_above_byte = SBYTES (string); if (EQ (string, string_char_byte_cache_string)) { @@ -894,40 +833,30 @@ string_char_to_byte (string, char_index) if (char_index - best_below < best_above - char_index) { + unsigned char *p = SDATA (string) + best_below_byte; + while (best_below < char_index) { - int c; - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, - best_below, best_below_byte); + p += BYTES_BY_CHAR_HEAD (*p); + best_below++; } - i = best_below; - i_byte = best_below_byte; + i_byte = p - SDATA (string); } else { + unsigned char *p = SDATA (string) + best_above_byte; + while (best_above > char_index) { - unsigned char *pend = XSTRING (string)->data + best_above_byte; - unsigned char *pbeg = pend - best_above_byte; - unsigned char *p = pend - 1; - int bytes; - - while (p > pbeg && !CHAR_HEAD_P (*p)) p--; - PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); - if (bytes == pend - p) - best_above_byte -= bytes; - else if (bytes > pend - p) - best_above_byte -= (pend - p); - else - best_above_byte--; + p--; + while (!CHAR_HEAD_P (*p)) p--; best_above--; } - i = best_above; - i_byte = best_above_byte; + i_byte = p - SDATA (string); } string_char_byte_cache_bytepos = i_byte; - string_char_byte_cache_charpos = i; + string_char_byte_cache_charpos = char_index; string_char_byte_cache_string = string; return i_byte; @@ -948,8 +877,8 @@ string_byte_to_char (string, byte_index) return byte_index; best_below = best_below_byte = 0; - best_above = XSTRING (string)->size; - best_above_byte = STRING_BYTES (XSTRING (string)); + best_above = SCHARS (string); + best_above_byte = SBYTES (string); if (EQ (string, string_char_byte_cache_string)) { @@ -967,36 +896,30 @@ string_byte_to_char (string, byte_index) if (byte_index - best_below_byte < best_above_byte - byte_index) { - while (best_below_byte < byte_index) + unsigned char *p = SDATA (string) + best_below_byte; + unsigned char *pend = SDATA (string) + byte_index; + + while (p < pend) { - int c; - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, - best_below, best_below_byte); + p += BYTES_BY_CHAR_HEAD (*p); + best_below++; } i = best_below; - i_byte = best_below_byte; + i_byte = p - SDATA (string); } else { - while (best_above_byte > byte_index) + unsigned char *p = SDATA (string) + best_above_byte; + unsigned char *pbeg = SDATA (string) + byte_index; + + while (p > pbeg) { - unsigned char *pend = XSTRING (string)->data + best_above_byte; - unsigned char *pbeg = pend - best_above_byte; - unsigned char *p = pend - 1; - int bytes; - - while (p > pbeg && !CHAR_HEAD_P (*p)) p--; - PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); - if (bytes == pend - p) - best_above_byte -= bytes; - else if (bytes > pend - p) - best_above_byte -= (pend - p); - else - best_above_byte--; + p--; + while (!CHAR_HEAD_P (*p)) p--; best_above--; } i = best_above; - i_byte = best_above_byte; + i_byte = p - SDATA (string); } string_char_byte_cache_bytepos = i_byte; @@ -1006,9 +929,7 @@ string_byte_to_char (string, byte_index) return i; } -/* Convert STRING to a multibyte string. - Single-byte characters 0240 through 0377 are converted - by adding nonascii_insert_offset to each. */ +/* Convert STRING to a multibyte string. */ Lisp_Object string_make_multibyte (string) @@ -1020,20 +941,49 @@ string_make_multibyte (string) if (STRING_MULTIBYTE (string)) return string; - nbytes = count_size_as_multibyte (XSTRING (string)->data, - XSTRING (string)->size); + nbytes = count_size_as_multibyte (SDATA (string), + SCHARS (string)); /* If all the chars are ASCII, they won't need any more bytes once converted. In that case, we can return STRING itself. */ - if (nbytes == STRING_BYTES (XSTRING (string))) + if (nbytes == SBYTES (string)) return string; buf = (unsigned char *) alloca (nbytes); - copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)), + copy_text (SDATA (string), buf, SBYTES (string), 0, 1); - return make_multibyte_string (buf, XSTRING (string)->size, nbytes); + return make_multibyte_string (buf, SCHARS (string), nbytes); } + +/* Convert STRING (if unibyte) to a multibyte string without changing + the number of characters. Characters 0200 trough 0237 are + converted to eight-bit characters. */ + +Lisp_Object +string_to_multibyte (string) + Lisp_Object string; +{ + unsigned char *buf; + int nbytes; + + if (STRING_MULTIBYTE (string)) + return string; + + nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); + /* If all the chars are ASCII, they won't need any more bytes once + converted. */ + if (nbytes == SBYTES (string)) + return make_multibyte_string (SDATA (string), nbytes, nbytes); + + buf = (unsigned char *) alloca (nbytes); + bcopy (SDATA (string), buf, SBYTES (string)); + str_to_multibyte (buf, nbytes, SBYTES (string)); + + return make_multibyte_string (buf, SCHARS (string), nbytes); +} + + /* Convert STRING to a single-byte string. */ Lisp_Object @@ -1045,12 +995,12 @@ string_make_unibyte (string) if (! STRING_MULTIBYTE (string)) return string; - buf = (unsigned char *) alloca (XSTRING (string)->size); + buf = (unsigned char *) alloca (SCHARS (string)); - copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)), + copy_text (SDATA (string), buf, SBYTES (string), 1, 0); - return make_unibyte_string (buf, XSTRING (string)->size); + return make_unibyte_string (buf, SCHARS (string)); } DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, @@ -1061,7 +1011,7 @@ each unibyte character to a multibyte character. */) (string) Lisp_Object string; { - CHECK_STRING (string, 0); + CHECK_STRING (string); return string_make_multibyte (string); } @@ -1069,12 +1019,14 @@ each unibyte character to a multibyte character. */) DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte, 1, 1, 0, doc: /* Return the unibyte equivalent of STRING. -Multibyte character codes are converted to unibyte -by using just the low 8 bits. */) +Multibyte character codes are converted to unibyte according to +`nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'. +If the lookup in the translation table fails, this function takes just +the low 8 bits of each character. */) (string) Lisp_Object string; { - CHECK_STRING (string, 0); + CHECK_STRING (string); return string_make_unibyte (string); } @@ -1090,14 +1042,14 @@ corresponding single byte. */) (string) Lisp_Object string; { - CHECK_STRING (string, 0); + CHECK_STRING (string); if (STRING_MULTIBYTE (string)) { - int bytes = STRING_BYTES (XSTRING (string)); + int bytes = SBYTES (string); unsigned char *str = (unsigned char *) xmalloc (bytes); - bcopy (XSTRING (string)->data, str, bytes); + bcopy (SDATA (string), str, bytes); bytes = str_as_unibyte (str, bytes); string = make_unibyte_string (str, bytes); xfree (str); @@ -1110,33 +1062,56 @@ DEFUN ("string-as-multibyte", Fstring_as_multibyte, Sstring_as_multibyte, doc: /* Return a multibyte string with the same individual bytes as STRING. If STRING is multibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties. + If STRING is unibyte and contains an individual 8-bit byte (i.e. not -part of a multibyte form), it is converted to the corresponding -multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. */) +part of a correct utf-8 sequence), it is converted to the corresponding +multibyte character of charset `eight-bit'. +See also `string-to-multibyte'. */) (string) Lisp_Object string; { - CHECK_STRING (string, 0); + CHECK_STRING (string); if (! STRING_MULTIBYTE (string)) { Lisp_Object new_string; int nchars, nbytes; - parse_str_as_multibyte (XSTRING (string)->data, - STRING_BYTES (XSTRING (string)), + parse_str_as_multibyte (SDATA (string), + SBYTES (string), &nchars, &nbytes); new_string = make_uninit_multibyte_string (nchars, nbytes); - bcopy (XSTRING (string)->data, XSTRING (new_string)->data, - STRING_BYTES (XSTRING (string))); - if (nbytes != STRING_BYTES (XSTRING (string))) - str_as_multibyte (XSTRING (new_string)->data, nbytes, - STRING_BYTES (XSTRING (string)), NULL); + bcopy (SDATA (string), SDATA (new_string), + SBYTES (string)); + if (nbytes != SBYTES (string)) + str_as_multibyte (SDATA (new_string), nbytes, + SBYTES (string), NULL); string = new_string; - XSTRING (string)->intervals = NULL_INTERVAL; + STRING_SET_INTERVALS (string, NULL_INTERVAL); } return string; } + +DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte, + 1, 1, 0, + doc: /* Return a multibyte string with the same individual chars as STRING. +If STRING is multibyte, the result is STRING itself. +Otherwise it is a newly created string, with no text properties. + +If STRING is unibyte and contains an 8-bit byte, it is converted to +the corresponding multibyte character of charset `eight-bit'. + +This differs from `string-as-multibyte' by converting each byte of a correct +utf-8 sequence to an eight-bit character, not just bytes that don't form a +correct sequence. */) + (string) + Lisp_Object string; +{ + CHECK_STRING (string); + + return string_to_multibyte (string); +} + DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0, doc: /* Return a copy of ALIST. @@ -1150,7 +1125,7 @@ Elements of ALIST that are not conses are also shared. */) { register Lisp_Object tem; - CHECK_LIST (alist, 0); + CHECK_LIST (alist); if (NILP (alist)) return alist; alist = concat (1, &alist, Lisp_Cons, 0); @@ -1166,10 +1141,9 @@ Elements of ALIST that are not conses are also shared. */) } DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, - doc: /* -Return a substring of STRING, starting at index FROM and ending before TO. + doc: /* Return a substring of STRING, starting at index FROM and ending before TO. TO may be nil or omitted; then the substring runs to the end of STRING. -If FROM or TO is negative, it counts from the end. +FROM and TO start at 0. If either is negative, it counts from the end. This function allows vectors as well as strings. */) (string, from, to) @@ -1185,12 +1159,12 @@ This function allows vectors as well as strings. */) if (! (STRINGP (string) || VECTORP (string))) wrong_type_argument (Qarrayp, string); - CHECK_NUMBER (from, 1); + CHECK_NUMBER (from); if (STRINGP (string)) { - size = XSTRING (string)->size; - size_byte = STRING_BYTES (XSTRING (string)); + size = SCHARS (string); + size_byte = SBYTES (string); } else size = XVECTOR (string)->size; @@ -1202,7 +1176,7 @@ This function allows vectors as well as strings. */) } else { - CHECK_NUMBER (to, 2); + CHECK_NUMBER (to); to_char = XINT (to); if (to_char < 0) @@ -1224,7 +1198,7 @@ This function allows vectors as well as strings. */) if (STRINGP (string)) { - res = make_specified_string (XSTRING (string)->data + from_byte, + res = make_specified_string (SDATA (string) + from_byte, to_char - from_char, to_byte - from_byte, STRING_MULTIBYTE (string)); copy_text_properties (make_number (from_char), make_number (to_char), @@ -1237,6 +1211,65 @@ This function allows vectors as well as strings. */) return res; } + +DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0, + doc: /* Return a substring of STRING, without text properties. +It starts at index FROM and ending before TO. +TO may be nil or omitted; then the substring runs to the end of STRING. +If FROM is nil or omitted, the substring starts at the beginning of STRING. +If FROM or TO is negative, it counts from the end. + +With one argument, just copy STRING without its properties. */) + (string, from, to) + Lisp_Object string; + register Lisp_Object from, to; +{ + int size, size_byte; + int from_char, to_char; + int from_byte, to_byte; + + CHECK_STRING (string); + + size = SCHARS (string); + size_byte = SBYTES (string); + + if (NILP (from)) + from_char = from_byte = 0; + else + { + CHECK_NUMBER (from); + from_char = XINT (from); + if (from_char < 0) + from_char += size; + + from_byte = string_char_to_byte (string, from_char); + } + + if (NILP (to)) + { + to_char = size; + to_byte = size_byte; + } + else + { + CHECK_NUMBER (to); + + to_char = XINT (to); + if (to_char < 0) + to_char += size; + + to_byte = string_char_to_byte (string, to_char); + } + + if (!(0 <= from_char && from_char <= to_char && to_char <= size)) + args_out_of_range_3 (string, make_number (from_char), + make_number (to_char)); + + return make_specified_string (SDATA (string) + from_byte, + to_char - from_char, to_byte - from_byte, + STRING_MULTIBYTE (string)); +} + /* Extract a substring of STRING, giving start and end positions both in characters and in bytes. */ @@ -1254,8 +1287,8 @@ substring_both (string, from, from_byte, to, to_byte) if (STRINGP (string)) { - size = XSTRING (string)->size; - size_byte = STRING_BYTES (XSTRING (string)); + size = SCHARS (string); + size_byte = SBYTES (string); } else size = XVECTOR (string)->size; @@ -1265,7 +1298,7 @@ substring_both (string, from, from_byte, to, to_byte) if (STRINGP (string)) { - res = make_specified_string (XSTRING (string)->data + from_byte, + res = make_specified_string (SDATA (string) + from_byte, to - from, to_byte - from_byte, STRING_MULTIBYTE (string)); copy_text_properties (make_number (from), make_number (to), @@ -1285,7 +1318,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, register Lisp_Object list; { register int i, num; - CHECK_NUMBER (n, 0); + CHECK_NUMBER (n); num = XINT (n); for (i = 0; i < num && !NILP (list); i++) { @@ -1311,7 +1344,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, (sequence, n) register Lisp_Object sequence, n; { - CHECK_NUMBER (n, 0); + CHECK_NUMBER (n); while (1) { if (CONSP (sequence) || NILP (sequence)) @@ -1633,18 +1666,18 @@ to be sure of changing the value of `foo'. */) int c; for (i = nchars = nbytes = ibyte = 0; - i < XSTRING (seq)->size; + i < SCHARS (seq); ++i, ibyte += cbytes) { if (STRING_MULTIBYTE (seq)) { - c = STRING_CHAR (&XSTRING (seq)->data[ibyte], - STRING_BYTES (XSTRING (seq)) - ibyte); + c = STRING_CHAR (SDATA (seq) + ibyte, + SBYTES (seq) - ibyte); cbytes = CHAR_BYTES (c); } else { - c = XSTRING (seq)->data[i]; + c = SREF (seq, i); cbytes = 1; } @@ -1655,34 +1688,34 @@ to be sure of changing the value of `foo'. */) } } - if (nchars != XSTRING (seq)->size) + if (nchars != SCHARS (seq)) { Lisp_Object tem; tem = make_uninit_multibyte_string (nchars, nbytes); if (!STRING_MULTIBYTE (seq)) - SET_STRING_BYTES (XSTRING (tem), -1); + STRING_SET_UNIBYTE (tem); for (i = nchars = nbytes = ibyte = 0; - i < XSTRING (seq)->size; + i < SCHARS (seq); ++i, ibyte += cbytes) { if (STRING_MULTIBYTE (seq)) { - c = STRING_CHAR (&XSTRING (seq)->data[ibyte], - STRING_BYTES (XSTRING (seq)) - ibyte); + c = STRING_CHAR (SDATA (seq) + ibyte, + SBYTES (seq) - ibyte); cbytes = CHAR_BYTES (c); } else { - c = XSTRING (seq)->data[i]; + c = SREF (seq, i); cbytes = 1; } if (!INTEGERP (elt) || c != XINT (elt)) { - unsigned char *from = &XSTRING (seq)->data[ibyte]; - unsigned char *to = &XSTRING (tem)->data[nbytes]; + unsigned char *from = SDATA (seq) + ibyte; + unsigned char *to = SDATA (tem) + nbytes; EMACS_INT n; ++nchars; @@ -1746,7 +1779,7 @@ Returns the beginning of the reversed list. */) } DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, - doc: /* Reverse LIST, copying. Returns the beginning of the reversed list. + doc: /* Reverse LIST, copying. Returns the beginning of the reversed list. See also the function `nreverse', which is used more often. */) (list) Lisp_Object list; @@ -1754,7 +1787,10 @@ See also the function `nreverse', which is used more often. */) Lisp_Object new; for (new = Qnil; CONSP (list); list = XCDR (list)) - new = Fcons (XCAR (list), new); + { + QUIT; + new = Fcons (XCAR (list), new); + } if (!NILP (list)) wrong_type_argument (Qconsp, list); return new; @@ -1865,7 +1901,7 @@ one of the properties on the list. */) Lisp_Object prop; { Lisp_Object tail; - + for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) @@ -1881,7 +1917,7 @@ one of the properties on the list. */) if (!NILP (tail)) wrong_type_argument (Qlistp, prop); - + return Qnil; } @@ -1891,7 +1927,7 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) (symbol, propname) Lisp_Object symbol, propname; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); return Fplist_get (XSYMBOL (symbol)->plist, propname); } @@ -1919,7 +1955,7 @@ The PLIST is modified by side effects. */) Fsetcar (XCDR (tail), val); return plist; } - + prev = tail; QUIT; } @@ -1937,12 +1973,76 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */) (symbol, propname, value) Lisp_Object symbol, propname, value; { - CHECK_SYMBOL (symbol, 0); + CHECK_SYMBOL (symbol); XSYMBOL (symbol)->plist = Fplist_put (XSYMBOL (symbol)->plist, propname, value); return value; } + +DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0, + doc: /* Extract a value from a property list, comparing with `equal'. +PLIST is a property list, which is a list of the form +\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value +corresponding to the given PROP, or nil if PROP is not +one of the properties on the list. */) + (plist, prop) + Lisp_Object plist; + Lisp_Object prop; +{ + Lisp_Object tail; + + for (tail = plist; + CONSP (tail) && CONSP (XCDR (tail)); + tail = XCDR (XCDR (tail))) + { + if (! NILP (Fequal (prop, XCAR (tail)))) + return XCAR (XCDR (tail)); + + QUIT; + } + + if (!NILP (tail)) + wrong_type_argument (Qlistp, prop); + + return Qnil; +} +DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0, + doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'. +PLIST is a property list, which is a list of the form +\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects. +If PROP is already a property on the list, its value is set to VAL, +otherwise the new PROP VAL pair is added. The new plist is returned; +use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. +The PLIST is modified by side effects. */) + (plist, prop, val) + Lisp_Object plist; + register Lisp_Object prop; + Lisp_Object val; +{ + register Lisp_Object tail, prev; + Lisp_Object newcell; + prev = Qnil; + for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); + tail = XCDR (XCDR (tail))) + { + if (! NILP (Fequal (prop, XCAR (tail)))) + { + Fsetcar (XCDR (tail), val); + return plist; + } + + prev = tail; + QUIT; + } + newcell = Fcons (prop, Fcons (val, Qnil)); + if (NILP (prev)) + return newcell; + else + Fsetcdr (XCDR (prev), newcell); + return plist; +} + DEFUN ("equal", Fequal, Sequal, 2, 2, 0, doc: /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. @@ -2035,7 +2135,8 @@ internal_equal (o1, o2, depth) functions are sensible to compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) + if (!(size & (PVEC_COMPILED + | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -2052,12 +2153,12 @@ internal_equal (o1, o2, depth) break; case Lisp_String: - if (XSTRING (o1)->size != XSTRING (o2)->size) + if (SCHARS (o1) != SCHARS (o2)) return 0; - if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2))) + if (SBYTES (o1) != SBYTES (o2)) return 0; - if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, - STRING_BYTES (XSTRING (o1)))) + if (bcmp (SDATA (o1), SDATA (o2), + SBYTES (o1))) return 0; return 1; @@ -2066,7 +2167,7 @@ internal_equal (o1, o2, depth) case Lisp_Type_Limit: break; } - + return 0; } @@ -2089,23 +2190,23 @@ ARRAY is a vector, string, char-table, or bool-vector. */) } else if (CHAR_TABLE_P (array)) { - register Lisp_Object *p = XCHAR_TABLE (array)->contents; - size = CHAR_TABLE_ORDINARY_SLOTS; - for (index = 0; index < size; index++) - p[index] = item; - XCHAR_TABLE (array)->defalt = Qnil; + int i; + + for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) + XCHAR_TABLE (array)->contents[i] = item; + XCHAR_TABLE (array)->defalt = item; } else if (STRINGP (array)) { - register unsigned char *p = XSTRING (array)->data; - CHECK_NUMBER (item, 1); + register unsigned char *p = SDATA (array); + CHECK_NUMBER (item); charval = XINT (item); - size = XSTRING (array)->size; + size = SCHARS (array); if (STRING_MULTIBYTE (array)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (charval, str); - int size_byte = STRING_BYTES (XSTRING (array)); + int size_byte = SBYTES (array); unsigned char *p1 = p, *endp = p + size_byte; int i; @@ -2141,438 +2242,20 @@ ARRAY is a vector, string, char-table, or bool-vector. */) } return array; } - -DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype, - 1, 1, 0, - doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */) - (char_table) - Lisp_Object char_table; -{ - CHECK_CHAR_TABLE (char_table, 0); - - return XCHAR_TABLE (char_table)->purpose; -} -DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent, +DEFUN ("clear-string", Fclear_string, Sclear_string, 1, 1, 0, - doc: /* Return the parent char-table of CHAR-TABLE. -The value is either nil or another char-table. -If CHAR-TABLE holds nil for a given character, -then the actual applicable value is inherited from the parent char-table -\(or from its parents, if necessary). */) - (char_table) - Lisp_Object char_table; -{ - CHECK_CHAR_TABLE (char_table, 0); - - return XCHAR_TABLE (char_table)->parent; -} - -DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent, - 2, 2, 0, - doc: /* Set the parent char-table of CHAR-TABLE to PARENT. -PARENT must be either nil or another char-table. */) - (char_table, parent) - Lisp_Object char_table, parent; -{ - Lisp_Object temp; - - CHECK_CHAR_TABLE (char_table, 0); - - if (!NILP (parent)) - { - CHECK_CHAR_TABLE (parent, 0); - - for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent) - if (EQ (temp, char_table)) - error ("Attempt to make a chartable be its own parent"); - } - - XCHAR_TABLE (char_table)->parent = parent; - - return parent; -} - -DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, - 2, 2, 0, - doc: /* Return the value of CHAR-TABLE's extra-slot number N. */) - (char_table, n) - Lisp_Object char_table, n; -{ - CHECK_CHAR_TABLE (char_table, 1); - CHECK_NUMBER (n, 2); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) - args_out_of_range (char_table, n); - - return XCHAR_TABLE (char_table)->extras[XINT (n)]; -} - -DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, - Sset_char_table_extra_slot, - 3, 3, 0, - doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */) - (char_table, n, value) - Lisp_Object char_table, n, value; -{ - CHECK_CHAR_TABLE (char_table, 1); - CHECK_NUMBER (n, 2); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) - args_out_of_range (char_table, n); - - return XCHAR_TABLE (char_table)->extras[XINT (n)] = value; -} - -DEFUN ("char-table-range", Fchar_table_range, Schar_table_range, - 2, 2, 0, - doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. -RANGE should be nil (for the default value) -a vector which identifies a character set or a row of a character set, -a character set name, or a character code. */) - (char_table, range) - Lisp_Object char_table, range; -{ - CHECK_CHAR_TABLE (char_table, 0); - - if (EQ (range, Qnil)) - return XCHAR_TABLE (char_table)->defalt; - else if (INTEGERP (range)) - return Faref (char_table, range); - else if (SYMBOLP (range)) - { - Lisp_Object charset_info; - - charset_info = Fget (range, Qcharset); - CHECK_VECTOR (charset_info, 0); - - return Faref (char_table, - make_number (XINT (XVECTOR (charset_info)->contents[0]) - + 128)); - } - else if (VECTORP (range)) - { - if (XVECTOR (range)->size == 1) - return Faref (char_table, - make_number (XINT (XVECTOR (range)->contents[0]) + 128)); - else - { - int size = XVECTOR (range)->size; - Lisp_Object *val = XVECTOR (range)->contents; - Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], - size <= 1 ? Qnil : val[1], - size <= 2 ? Qnil : val[2]); - return Faref (char_table, ch); - } - } - else - error ("Invalid RANGE argument to `char-table-range'"); - return Qt; -} - -DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, - 3, 3, 0, - doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. -RANGE should be t (for all characters), nil (for the default value) -a vector which identifies a character set or a row of a character set, -a coding system, or a character code. */) - (char_table, range, value) - Lisp_Object char_table, range, value; -{ - int i; - - CHECK_CHAR_TABLE (char_table, 0); - - if (EQ (range, Qt)) - for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - XCHAR_TABLE (char_table)->contents[i] = value; - else if (EQ (range, Qnil)) - XCHAR_TABLE (char_table)->defalt = value; - else if (SYMBOLP (range)) - { - Lisp_Object charset_info; - - charset_info = Fget (range, Qcharset); - CHECK_VECTOR (charset_info, 0); - - return Faset (char_table, - make_number (XINT (XVECTOR (charset_info)->contents[0]) - + 128), - value); - } - else if (INTEGERP (range)) - Faset (char_table, range, value); - else if (VECTORP (range)) - { - if (XVECTOR (range)->size == 1) - return Faset (char_table, - make_number (XINT (XVECTOR (range)->contents[0]) + 128), - value); - else - { - int size = XVECTOR (range)->size; - Lisp_Object *val = XVECTOR (range)->contents; - Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], - size <= 1 ? Qnil : val[1], - size <= 2 ? Qnil : val[2]); - return Faset (char_table, ch, value); - } - } - else - error ("Invalid RANGE argument to `set-char-table-range'"); - - return value; -} - -DEFUN ("set-char-table-default", Fset_char_table_default, - Sset_char_table_default, 3, 3, 0, - doc: /* Set the default value in CHAR-TABLE for a generic character CHAR to VALUE. -The generic character specifies the group of characters. -See also the documentation of make-char. */) - (char_table, ch, value) - Lisp_Object char_table, ch, value; -{ - int c, charset, code1, code2; - Lisp_Object temp; - - CHECK_CHAR_TABLE (char_table, 0); - CHECK_NUMBER (ch, 1); - - c = XINT (ch); - SPLIT_CHAR (c, charset, code1, code2); - - /* Since we may want to set the default value for a character set - not yet defined, we check only if the character set is in the - valid range or not, instead of it is already defined or not. */ - if (! CHARSET_VALID_P (charset)) - invalid_character (c); - - if (charset == CHARSET_ASCII) - return (XCHAR_TABLE (char_table)->defalt = value); - - /* Even if C is not a generic char, we had better behave as if a - generic char is specified. */ - if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1) - code1 = 0; - temp = XCHAR_TABLE (char_table)->contents[charset + 128]; - if (!code1) - { - if (SUB_CHAR_TABLE_P (temp)) - XCHAR_TABLE (temp)->defalt = value; - else - XCHAR_TABLE (char_table)->contents[charset + 128] = value; - return value; - } - if (SUB_CHAR_TABLE_P (temp)) - char_table = temp; - else - char_table = (XCHAR_TABLE (char_table)->contents[charset + 128] - = make_sub_char_table (temp)); - temp = XCHAR_TABLE (char_table)->contents[code1]; - if (SUB_CHAR_TABLE_P (temp)) - XCHAR_TABLE (temp)->defalt = value; - else - XCHAR_TABLE (char_table)->contents[code1] = value; - return value; -} - -/* Look up the element in TABLE at index CH, - and return it as an integer. - If the element is nil, return CH itself. - (Actually we do that for any non-integer.) */ - -int -char_table_translate (table, ch) - Lisp_Object table; - int ch; -{ - Lisp_Object value; - value = Faref (table, make_number (ch)); - if (! INTEGERP (value)) - return ch; - return XINT (value); -} - -static void -optimize_sub_char_table (table, chars) - Lisp_Object *table; - int chars; -{ - Lisp_Object elt; - int from, to; - - if (chars == 94) - from = 33, to = 127; - else - from = 32, to = 128; - - if (!SUB_CHAR_TABLE_P (*table)) - return; - elt = XCHAR_TABLE (*table)->contents[from++]; - for (; from < to; from++) - if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from]))) - return; - *table = elt; -} - -DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, - 1, 1, 0, doc: /* Optimize char table TABLE. */) - (table) - Lisp_Object table; -{ - Lisp_Object elt; - int dim; - int i, j; - - CHECK_CHAR_TABLE (table, 0); - - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - { - elt = XCHAR_TABLE (table)->contents[i]; - if (!SUB_CHAR_TABLE_P (elt)) - continue; - dim = CHARSET_DIMENSION (i - 128); - if (dim == 2) - for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++) - optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim); - optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim); - } - return Qnil; -} - - -/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each - character or group of characters that share a value. - DEPTH is the current depth in the originally specified - chartable, and INDICES contains the vector indices - for the levels our callers have descended. - - ARG is passed to C_FUNCTION when that is called. */ - -void -map_char_table (c_function, function, subtable, arg, depth, indices) - void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); - Lisp_Object function, subtable, arg, *indices; - int depth; -{ - int i, to; - - if (depth == 0) - { - /* At first, handle ASCII and 8-bit European characters. */ - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - { - Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i]; - if (c_function) - (*c_function) (arg, make_number (i), elt); - else - call2 (function, make_number (i), elt); - } -#if 0 /* If the char table has entries for higher characters, - we should report them. */ - if (NILP (current_buffer->enable_multibyte_characters)) - return; -#endif - to = CHAR_TABLE_ORDINARY_SLOTS; - } - else - { - int charset = XFASTINT (indices[0]) - 128; - - i = 32; - to = SUB_CHAR_TABLE_ORDINARY_SLOTS; - if (CHARSET_CHARS (charset) == 94) - i++, to--; - } - - for (; i < to; i++) - { - Lisp_Object elt; - int charset; - - elt = XCHAR_TABLE (subtable)->contents[i]; - XSETFASTINT (indices[depth], i); - charset = XFASTINT (indices[0]) - 128; - if (depth == 0 - && (!CHARSET_DEFINED_P (charset) - || charset == CHARSET_8_BIT_CONTROL - || charset == CHARSET_8_BIT_GRAPHIC)) - continue; - - if (SUB_CHAR_TABLE_P (elt)) - { - if (depth >= 3) - error ("Too deep char table"); - map_char_table (c_function, function, elt, arg, depth + 1, indices); - } - else - { - int c1, c2, c; - - if (NILP (elt)) - elt = XCHAR_TABLE (subtable)->defalt; - c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; - c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; - c = MAKE_CHAR (charset, c1, c2); - if (c_function) - (*c_function) (arg, make_number (c), elt); - else - call2 (function, make_number (c), elt); - } - } -} - -DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, - 2, 2, 0, - doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE. -FUNCTION is called with two arguments--a key and a value. -The key is always a possible IDX argument to `aref'. */) - (function, char_table) - Lisp_Object function, char_table; + doc: /* Clear the contents of STRING. +This makes STRING unibyte and may change its length. */) + (string) + Lisp_Object string; { - /* The depth of char table is at most 3. */ - Lisp_Object indices[3]; - - CHECK_CHAR_TABLE (char_table, 1); - - map_char_table (NULL, function, char_table, char_table, 0, indices); + int len = SBYTES (string); + bzero (SDATA (string), len); + STRING_SET_CHARS (string, len); + STRING_SET_UNIBYTE (string); return Qnil; } - -/* Return a value for character C in char-table TABLE. Store the - actual index for that value in *IDX. Ignore the default value of - TABLE. */ - -Lisp_Object -char_table_ref_and_index (table, c, idx) - Lisp_Object table; - int c, *idx; -{ - int charset, c1, c2; - Lisp_Object elt; - - if (SINGLE_BYTE_CHAR_P (c)) - { - *idx = c; - return XCHAR_TABLE (table)->contents[c]; - } - SPLIT_CHAR (c, charset, c1, c2); - elt = XCHAR_TABLE (table)->contents[charset + 128]; - *idx = MAKE_CHAR (charset, 0, 0); - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1])) - return XCHAR_TABLE (elt)->defalt; - elt = XCHAR_TABLE (elt)->contents[c1]; - *idx = MAKE_CHAR (charset, c1, 0); - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2])) - return XCHAR_TABLE (elt)->defalt; - *idx = c; - return XCHAR_TABLE (elt)->contents[c2]; -} - /* ARGSUSED */ Lisp_Object @@ -2618,7 +2301,7 @@ usage: (nconc &rest LISTS) */) while (CONSP (tem)) { tail = tem; - tem = Fcdr (tail); + tem = XCDR (tail); QUIT; } @@ -2735,6 +2418,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) struct gcpro gcpro1; len = Flength (sequence); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); leni = XINT (len); nargs = leni + leni - 1; if (nargs < 0) return build_string (""); @@ -2766,6 +2451,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) register Lisp_Object *args; len = Flength (sequence); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); leni = XFASTINT (len); args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); @@ -2784,6 +2471,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) register int leni; leni = XFASTINT (Flength (sequence)); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); mapcar1 (leni, 0, function, sequence); return sequence; @@ -2811,13 +2500,13 @@ is nil and `use-dialog-box' is non-nil. */) Lisp_Object xprompt; Lisp_Object args[2]; struct gcpro gcpro1, gcpro2; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); map = Fsymbol_value (intern ("query-replace-map")); - CHECK_STRING (prompt, 0); + CHECK_STRING (prompt); xprompt = prompt; GCPRO2 (prompt, xprompt); @@ -2847,7 +2536,18 @@ is nil and `use-dialog-box' is non-nil. */) #endif /* HAVE_MENUS */ cursor_in_echo_area = 1; choose_minibuf_frame (); - message_with_string ("%s(y or n) ", xprompt, 0); + + { + Lisp_Object pargs[3]; + + /* Colorize prompt according to `minibuffer-prompt' face. */ + pargs[0] = build_string ("%s(y or n) "); + pargs[1] = intern ("face"); + pargs[2] = intern ("minibuffer-prompt"); + args[0] = Fpropertize (3, pargs); + args[1] = xprompt; + Fmessage (2, args); + } if (minibuffer_auto_raise) { @@ -2947,7 +2647,7 @@ is nil, and `use-dialog-box' is non-nil. */) Lisp_Object args[2]; struct gcpro gcpro1; - CHECK_STRING (prompt, 0); + CHECK_STRING (prompt); #ifdef HAVE_MENUS if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) @@ -2978,12 +2678,12 @@ is nil, and `use-dialog-box' is non-nil. */) ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil, Qyes_or_no_p_history, Qnil, Qnil)); - if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes")) + if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) { UNGCPRO; return Qt; } - if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no")) + if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) { UNGCPRO; return Qnil; @@ -2998,7 +2698,7 @@ is nil, and `use-dialog-box' is non-nil. */) DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0, doc: /* Return list of 1 minute, 5 minute and 15 minute load averages. - + Each of the three load averages is multiplied by 100, then converted to integer. @@ -3006,7 +2706,12 @@ When USE-FLOATS is non-nil, floats will be used instead of integers. These floats are not multiplied by 100. If the 5-minute or 15-minute load averages are not available, return a -shortened list, containing only those averages which are available. */) +shortened list, containing only those averages which are available. + +An error is thrown if the load average can't be obtained. In some +cases making it work would require Emacs being installed setuid or +setgid so that it can read kernel information, and that usually isn't +advisable. */) (use_floats) Lisp_Object use_floats; { @@ -3033,7 +2738,7 @@ extern Lisp_Object Vafter_load_alist; DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, doc: /* Returns t if FEATURE is present in this Emacs. - + Use this to conditionalize execution of lisp code based on the presence or absence of emacs or environment extensions. Use `provide' to declare that a feature is available. This function @@ -3043,10 +2748,10 @@ SUBFEATURE can be used to check a specific subfeature of FEATURE. */) Lisp_Object feature, subfeature; { register Lisp_Object tem; - CHECK_SYMBOL (feature, 0); + CHECK_SYMBOL (feature); tem = Fmemq (feature, Vfeatures); if (!NILP (tem) && !NILP (subfeature)) - tem = Fmemq (subfeature, Fget (feature, Qsubfeatures)); + tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); return (NILP (tem)) ? Qnil : Qt; } @@ -3058,7 +2763,8 @@ particular subfeatures supported in this version of FEATURE. */) Lisp_Object feature, subfeatures; { register Lisp_Object tem; - CHECK_SYMBOL (feature, 0); + CHECK_SYMBOL (feature); + CHECK_LIST (subfeatures); if (!NILP (Vautoload_queue)) Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); tem = Fmemq (feature, Vfeatures); @@ -3070,8 +2776,8 @@ particular subfeatures supported in this version of FEATURE. */) /* Run any load-hooks for this file. */ tem = Fassq (feature, Vafter_load_alist); - if (!NILP (tem)) - Fprogn (Fcdr (tem)); + if (CONSP (tem)) + Fprogn (XCDR (tem)); return feature; } @@ -3082,10 +2788,11 @@ particular subfeatures supported in this version of FEATURE. */) Lisp_Object require_nesting_list; +Lisp_Object require_unwind (old_value) Lisp_Object old_value; { - require_nesting_list = old_value; + return require_nesting_list = old_value; } DEFUN ("require", Frequire, Srequire, 1, 3, 0, @@ -3105,17 +2812,23 @@ The normal messages at start and end of loading FILENAME are suppressed. */) register Lisp_Object tem; struct gcpro gcpro1, gcpro2; - CHECK_SYMBOL (feature, 0); + CHECK_SYMBOL (feature); tem = Fmemq (feature, Vfeatures); - LOADHIST_ATTACH (Fcons (Qrequire, feature)); - if (NILP (tem)) { - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); int nesting = 0; - + + LOADHIST_ATTACH (Fcons (Qrequire, feature)); + + /* This is to make sure that loadup.el gives a clear picture + of what files are preloaded and when. */ + if (! NILP (Vpurify_flag)) + error ("(require %s) while preparing to dump", + SDATA (SYMBOL_NAME (feature))); + /* A certain amount of recursive `require' is legitimate, but if we require the same feature recursively 3 times, signal an error. */ @@ -3126,9 +2839,9 @@ The normal messages at start and end of loading FILENAME are suppressed. */) nesting++; tem = XCDR (tem); } - if (nesting > 2) + if (nesting > 3) error ("Recursive `require' for feature `%s'", - XSYMBOL (feature)->name->data); + SDATA (SYMBOL_NAME (feature))); /* Update the list for any nested `require's that occur. */ record_unwind_protect (require_unwind, require_nesting_list); @@ -3151,7 +2864,7 @@ The normal messages at start and end of loading FILENAME are suppressed. */) tem = Fmemq (feature, Vfeatures); if (NILP (tem)) error ("Required feature `%s' was not provided", - XSYMBOL (feature)->name->data); + SDATA (SYMBOL_NAME (feature))); /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; @@ -3193,7 +2906,7 @@ The value can later be retrieved with `widget-get'. */) (widget, property, value) Lisp_Object widget, property, value; { - CHECK_CONS (widget, 1); + CHECK_CONS (widget); XSETCDR (widget, Fplist_put (XCDR (widget), property, value)); return value; } @@ -3211,7 +2924,7 @@ later with `widget-put'. */) { if (NILP (widget)) return Qnil; - CHECK_CONS (widget, 1); + CHECK_CONS (widget); tmp = Fplist_member (XCDR (widget), property); if (CONSP (tmp)) { @@ -3246,6 +2959,92 @@ usage: (widget-apply WIDGET PROPERTY &rest ARGS) */) UNGCPRO; return result; } + +#ifdef HAVE_LANGINFO_CODESET +#include +#endif + +DEFUN ("locale-info", Flocale_info, Slocale_info, 1, 1, 0, + doc: /* Access locale data ITEM for the current C locale, if available. +ITEM should be one of the following: + +`codeset', returning the character set as a string (locale item CODESET); + +`days', returning a 7-element vector of day names (locale items DAY_n); + +`months', returning a 12-element vector of month names (locale items MON_n); + +`paper', returning a list (WIDTH HEIGHT) for the default paper size, + both measured in milimeters (locale items PAPER_WIDTH, PAPER_HEIGHT). + +If the system can't provide such information through a call to +`nl_langinfo', or if ITEM isn't from the list above, return nil. + +See also Info node `(libc)Locales'. + +The data read from the system are decoded using `locale-coding-system'. */) + (item) + Lisp_Object item; +{ + char *str = NULL; +#ifdef HAVE_LANGINFO_CODESET + Lisp_Object val; + if (EQ (item, Qcodeset)) + { + str = nl_langinfo (CODESET); + return build_string (str); + } +#ifdef DAY_1 + else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */ + { + Lisp_Object v = Fmake_vector (make_number (7), Qnil); + int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7}; + int i; + synchronize_system_time_locale (); + for (i = 0; i < 7; i++) + { + str = nl_langinfo (days[i]); + val = make_unibyte_string (str, strlen (str)); + /* Fixme: Is this coding system necessarily right, even if + it is consistent with CODESET? If not, what to do? */ + Faset (v, make_number (i), + code_convert_string_norecord (val, Vlocale_coding_system, + 0)); + } + return v; + } +#endif /* DAY_1 */ +#ifdef MON_1 + else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */ + { + struct Lisp_Vector *p = allocate_vector (12); + int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7, + MON_8, MON_9, MON_10, MON_11, MON_12}; + int i; + synchronize_system_time_locale (); + for (i = 0; i < 12; i++) + { + str = nl_langinfo (months[i]); + val = make_unibyte_string (str, strlen (str)); + p->contents[i] = + code_convert_string_norecord (val, Vlocale_coding_system, 0); + } + XSETVECTOR (val, p); + return val; + } +#endif /* MON_1 */ +/* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1, + but is in the locale files. This could be used by ps-print. */ +#ifdef PAPER_WIDTH + else if (EQ (item, Qpaper)) + { + return list2 (make_number (nl_langinfo (PAPER_WIDTH)), + make_number (nl_langinfo (PAPER_HEIGHT))); + } +#endif /* PAPER_WIDTH */ +#endif /* HAVE_LANGINFO_CODESET*/ + return Qnil; +} /* base64 encode/decode functions (RFC 2045). Based on code from GNU recode. */ @@ -3409,12 +3208,12 @@ into shorter lines. */) char *encoded; Lisp_Object encoded_string; - CHECK_STRING (string, 1); + CHECK_STRING (string); /* We need to allocate enough room for encoding the text. We need 33 1/3% more space, plus a newline every 76 characters, and then we round up. */ - length = STRING_BYTES (XSTRING (string)); + length = SBYTES (string); allength = length + length/3 + 1; allength += allength / MIME_LINE_LENGTH + 1 + 6; @@ -3424,7 +3223,7 @@ into shorter lines. */) else encoded = (char *) xmalloc (allength); - encoded_length = base64_encode_1 (XSTRING (string)->data, + encoded_length = base64_encode_1 (SDATA (string), encoded, length, NILP (no_line_break), STRING_MULTIBYTE (string)); if (encoded_length > allength) @@ -3464,7 +3263,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -3502,7 +3303,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -3524,7 +3327,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -3615,9 +3420,9 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, int length, decoded_length; Lisp_Object decoded_string; - CHECK_STRING (string, 1); + CHECK_STRING (string); - length = STRING_BYTES (XSTRING (string)); + length = SBYTES (string); /* We need to allocate enough room for decoding the text. */ if (length <= MAX_ALLOCA) decoded = (char *) alloca (length); @@ -3625,7 +3430,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, decoded = (char *) xmalloc (length); /* The decoded result should be unibyte. */ - decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length, + decoded_length = base64_decode_1 (SDATA (string), decoded, length, 0, NULL); if (decoded_length > length) abort (); @@ -3680,8 +3485,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c] << 12; c = (unsigned char) (value >> 16); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -3704,8 +3509,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c] << 6; c = (unsigned char) (0xff & value >> 8); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -3722,8 +3527,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c]; c = (unsigned char) (0xff & value); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -3753,32 +3558,6 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) if a `:linear-search t' argument is given to make-hash-table. */ -/* Value is the key part of entry IDX in hash table H. */ - -#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) - -/* Value is the value part of entry IDX in hash table H. */ - -#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) - -/* Value is the index of the next entry following the one at IDX - in hash table H. */ - -#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) - -/* Value is the hash code computed for entry IDX in hash table H. */ - -#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) - -/* Value is the index of the element in hash table H that is the - start of the collision list at index IDX in the index vector of H. */ - -#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) - -/* Value is the size of hash table H. */ - -#define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size - /* The list of all weak hash tables. Don't staticpro this one. */ Lisp_Object Vweak_hash_tables; @@ -3824,7 +3603,7 @@ static struct Lisp_Hash_Table * check_hash_table (obj) Lisp_Object obj; { - CHECK_HASH_TABLE (obj, 0); + CHECK_HASH_TABLE (obj); return XHASH_TABLE (obj); } @@ -4150,7 +3929,7 @@ copy_hash_table (h1) { Lisp_Object table; struct Lisp_Hash_Table *h2; - struct Lisp_Vector *v, *next; + struct Lisp_Vector *next; h2 = allocate_hash_table (); next = h2->vec_next; @@ -4458,13 +4237,13 @@ sweep_weak_table (h, remove_entries_p) /* Make sure key and value survive. */ if (!key_known_to_survive_p) { - mark_object (&HASH_KEY (h, i)); + mark_object (HASH_KEY (h, i)); marked = 1; } if (!value_known_to_survive_p) { - mark_object (&HASH_VALUE (h, i)); + mark_object (HASH_VALUE (h, i)); marked = 1; } } @@ -4509,7 +4288,7 @@ sweep_weak_hash_tables () { h = XHASH_TABLE (table); next = h->next_weak; - + if (h->size & ARRAY_MARK_FLAG) { /* TABLE is marked as used. Sweep its contents. */ @@ -4655,8 +4434,8 @@ sxhash (obj, depth) break; case Lisp_Symbol: - hash = sxhash_string (XSYMBOL (obj)->name->data, - XSYMBOL (obj)->name->size); + hash = sxhash_string (SDATA (SYMBOL_NAME (obj)), + SCHARS (SYMBOL_NAME (obj))); break; case Lisp_Misc: @@ -4664,7 +4443,7 @@ sxhash (obj, depth) break; case Lisp_String: - hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size); + hash = sxhash_string (SDATA (obj), SCHARS (obj)); break; /* This can be everything from a vector to an overlay. */ @@ -4722,7 +4501,7 @@ DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0, DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, doc: /* Create and return a new hash table. - + Arguments are specified as keyword/argument pairs. The following arguments are defined: @@ -4775,19 +4554,21 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object prop; prop = Fget (test, Qhash_table_test); - if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2) + if (!CONSP (prop) || !CONSP (XCDR (prop))) Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), test)); - user_test = Fnth (make_number (0), prop); - user_hash = Fnth (make_number (1), prop); + user_test = XCAR (prop); + user_hash = XCAR (XCDR (prop)); } else user_test = user_hash = Qnil; /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); - size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i]; - if (!INTEGERP (size) || XINT (size) < 0) + size = i < 0 ? Qnil : args[i]; + if (NILP (size)) + size = make_number (DEFAULT_HASH_SIZE); + else if (!INTEGERP (size) || XINT (size) < 0) Fsignal (Qerror, list2 (build_string ("Invalid hash table size"), size)); @@ -4845,22 +4626,6 @@ DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0, } -DEFUN ("makehash", Fmakehash, Smakehash, 0, 1, 0, - doc: /* Create a new hash table. - -Optional first argument TEST specifies how to compare keys in the -table. Predefined tests are `eq', `eql', and `equal'. Default is -`eql'. New tests can be defined with `define-hash-table-test'. */) - (test) - Lisp_Object test; -{ - Lisp_Object args[2]; - args[0] = QCtest; - args[1] = NILP (test) ? Qeql : test; - return Fmake_hash_table (2, args); -} - - DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, doc: /* Return the number of elements in TABLE. */) (table) @@ -5011,7 +4776,7 @@ FUNCTION is called with 2 arguments KEY and VALUE. */) DEFUN ("define-hash-table-test", Fdefine_hash_table_test, Sdefine_hash_table_test, 3, 3, 0, doc: /* Define a new hash table test with name NAME, a symbol. - + In hash tables created with NAME specified as test, use TEST to compare keys, and HASH for computing hash codes of keys. @@ -5033,11 +4798,10 @@ including negative integers. */) ************************************************************************/ #include "md5.h" -#include "coding.h" DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, doc: /* Return MD5 message digest of OBJECT, a buffer or string. - + A message digest is a cryptographic checksum of a document, and the algorithm to calculate it is defined in RFC 1321. @@ -5084,15 +4848,15 @@ guesswork fails. Normally, an error is signaled in such case. */) if (STRING_MULTIBYTE (object)) /* use default, we can't guess correct value */ - coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list)); - else + coding_system = preferred_coding_system (); + else coding_system = Qraw_text; } - + if (NILP (Fcoding_system_p (coding_system))) { /* Invalid coding system. */ - + if (!NILP (noerror)) coding_system = Qraw_text; else @@ -5101,14 +4865,14 @@ guesswork fails. Normally, an error is signaled in such case. */) } if (STRING_MULTIBYTE (object)) - object = code_convert_string1 (object, coding_system, Qnil, 1); + object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); - size = XSTRING (object)->size; - size_byte = STRING_BYTES (XSTRING (object)); + size = SCHARS (object); + size_byte = SBYTES (object); if (!NILP (start)) { - CHECK_NUMBER (start, 1); + CHECK_NUMBER (start); start_char = XINT (start); @@ -5125,31 +4889,31 @@ guesswork fails. Normally, an error is signaled in such case. */) } else { - CHECK_NUMBER (end, 2); - + CHECK_NUMBER (end); + end_char = XINT (end); if (end_char < 0) end_char += size; - + end_byte = string_char_to_byte (object, end_char); } - + if (!(0 <= start_char && start_char <= end_char && end_char <= size)) args_out_of_range_3 (object, make_number (start_char), make_number (end_char)); } else { - CHECK_BUFFER (object, 0); + CHECK_BUFFER (object); bp = XBUFFER (object); - + if (NILP (start)) b = BUF_BEGV (bp); else { - CHECK_NUMBER_COERCE_MARKER (start, 0); + CHECK_NUMBER_COERCE_MARKER (start); b = XINT (start); } @@ -5157,19 +4921,19 @@ guesswork fails. Normally, an error is signaled in such case. */) e = BUF_ZV (bp); else { - CHECK_NUMBER_COERCE_MARKER (end, 1); + CHECK_NUMBER_COERCE_MARKER (end); e = XINT (end); } - + if (b > e) temp = b, b = e, e = temp; - + if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp))) args_out_of_range (start, end); - + if (NILP (coding_system)) { - /* Decide the coding-system to encode the data with. + /* Decide the coding-system to encode the data with. See fileio.c:Fwrite-region */ if (!NILP (Vcoding_system_for_write)) @@ -5191,7 +4955,7 @@ guesswork fails. Normally, an error is signaled in such case. */) { /* Check file-coding-system-alist. */ Lisp_Object args[4], val; - + args[0] = Qwrite_region; args[1] = start; args[2] = end; args[3] = Fbuffer_file_name(object); val = Ffind_operation_coding_system (4, args); @@ -5210,9 +4974,9 @@ guesswork fails. Normally, an error is signaled in such case. */) if (!force_raw_text && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ - coding_system = call3 (Vselect_safe_coding_system_function, + coding_system = call4 (Vselect_safe_coding_system_function, make_number (b), make_number (e), - coding_system); + coding_system, Qnil); if (force_raw_text) coding_system = Qraw_text; @@ -5233,11 +4997,11 @@ guesswork fails. Normally, an error is signaled in such case. */) object = make_buffer_string (b, e, 0); if (STRING_MULTIBYTE (object)) - object = code_convert_string1 (object, coding_system, Qnil, 1); + object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); } - md5_buffer (XSTRING (object)->data + start_byte, - STRING_BYTES(XSTRING (object)) - (size_byte - end_byte), + md5_buffer (SDATA (object) + start_byte, + SBYTES (object) - (size_byte - end_byte), digest); for (i = 0; i < 16; i++) @@ -5284,7 +5048,6 @@ syms_of_fns () defsubr (&Ssxhash); defsubr (&Smake_hash_table); defsubr (&Scopy_hash_table); - defsubr (&Smakehash); defsubr (&Shash_table_count); defsubr (&Shash_table_rehash_size); defsubr (&Shash_table_rehash_threshold); @@ -5327,9 +5090,20 @@ Used by `featurep' and `require', and altered by `provide'. */); Qsubfeatures = intern ("subfeatures"); staticpro (&Qsubfeatures); +#ifdef HAVE_LANGINFO_CODESET + Qcodeset = intern ("codeset"); + staticpro (&Qcodeset); + Qdays = intern ("days"); + staticpro (&Qdays); + Qmonths = intern ("months"); + staticpro (&Qmonths); + Qpaper = intern ("paper"); + staticpro (&Qpaper); +#endif /* HAVE_LANGINFO_CODESET */ + DEFVAR_BOOL ("use-dialog-box", &use_dialog_box, doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. -This applies to y-or-n and yes-or-no questions asked by commands +This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands invoked by mouse clicks and mouse menu items. */); use_dialog_box = 1; @@ -5349,8 +5123,10 @@ invoked by mouse clicks and mouse menu items. */); defsubr (&Sstring_make_unibyte); defsubr (&Sstring_as_multibyte); defsubr (&Sstring_as_unibyte); + defsubr (&Sstring_to_multibyte); defsubr (&Scopy_alist); defsubr (&Ssubstring); + defsubr (&Ssubstring_no_properties); defsubr (&Snthcdr); defsubr (&Snth); defsubr (&Selt); @@ -5369,18 +5145,11 @@ invoked by mouse clicks and mouse menu items. */); defsubr (&Sget); defsubr (&Splist_put); defsubr (&Sput); + defsubr (&Slax_plist_get); + defsubr (&Slax_plist_put); defsubr (&Sequal); defsubr (&Sfillarray); - defsubr (&Schar_table_subtype); - defsubr (&Schar_table_parent); - defsubr (&Sset_char_table_parent); - defsubr (&Schar_table_extra_slot); - defsubr (&Sset_char_table_extra_slot); - defsubr (&Schar_table_range); - defsubr (&Sset_char_table_range); - defsubr (&Sset_char_table_default); - defsubr (&Soptimize_char_table); - defsubr (&Smap_char_table); + defsubr (&Sclear_string); defsubr (&Snconc); defsubr (&Smapcar); defsubr (&Smapc); @@ -5400,6 +5169,7 @@ invoked by mouse clicks and mouse menu items. */); defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); + defsubr (&Slocale_info); }