X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/799c08aca56838055c03bd84a7c7065d44961e3d..9d74382f6f75aafbd7eab700107bb1e31f640c8a:/src/fns.c diff --git a/src/fns.c b/src/fns.c index ae87f88896..f1602f0a7f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1,6 +1,7 @@ /* Random utility Lisp functions. - Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, + 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +17,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -26,8 +27,8 @@ Boston, MA 02111-1307, USA. */ #endif #include -#ifndef MAC_OSX -/* On Mac OS X, defining this conflicts with precompiled headers. */ +#ifndef MAC_OS +/* On Mac OS, 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. */ @@ -47,8 +48,12 @@ Boston, MA 02111-1307, USA. */ #include "frame.h" #include "window.h" #include "blockinput.h" -#if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS) +#ifdef HAVE_MENUS +#if defined (HAVE_X_WINDOWS) #include "xterm.h" +#elif defined (MAC_OS) +#include "macterm.h" +#endif #endif #ifndef NULL @@ -66,6 +71,7 @@ int use_file_dialog; extern int minibuffer_auto_raise; extern Lisp_Object minibuf_window; extern Lisp_Object Vlocale_coding_system; +extern int load_in_progress; Lisp_Object Qstring_lessp, Qprovide, Qrequire; Lisp_Object Qyes_or_no_p_history; @@ -75,10 +81,10 @@ Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; extern Lisp_Object Qinput_method_function; -static int internal_equal (); +static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int)); extern long get_random (); -extern void seed_random (); +extern void seed_random P_ ((long)); #ifndef HAVE_UNISTD_H extern long time (); @@ -185,8 +191,7 @@ To get the number of bytes, use `string-bytes'. */) return val; } -/* This does not check for quits. That is safe - since it must terminate. */ +/* This does not check for quits. That is safe since it must terminate. */ DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, doc: /* Return the length of a list, but avoid error or infinite loop. @@ -462,9 +467,10 @@ static Lisp_Object copy_sub_char_table (arg) Lisp_Object arg; { - Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt); + Lisp_Object copy = make_sub_char_table (Qnil); int i; + XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt; /* Copy all the contents. */ bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents, SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); @@ -562,6 +568,7 @@ concat (nargs, args, target_type, last_special) struct textprop_rec *textprops = NULL; /* Number of elments in textprops. */ int num_textprops = 0; + USE_SAFE_ALLOCA; tail = Qnil; @@ -670,8 +677,7 @@ concat (nargs, args, target_type, last_special) prev = Qnil; if (STRINGP (val)) - textprops - = (struct textprop_rec *) alloca (sizeof (struct textprop_rec) * nargs); + SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs); for (argnum = 0; argnum < nargs; argnum++) { @@ -741,7 +747,7 @@ concat (nargs, args, target_type, last_special) } else { - XSETFASTINT (elt, SREF (this, thisindex++)); + XSETFASTINT (elt, SREF (this, thisindex)); thisindex++; if (some_multibyte && (XINT (elt) >= 0240 || (XINT (elt) >= 0200 @@ -827,6 +833,8 @@ concat (nargs, args, target_type, last_special) last_to_end = textprops[argnum].to + SCHARS (this); } } + + SAFE_FREE (); return val; } @@ -1012,7 +1020,7 @@ string_make_multibyte (string) 0, 1); ret = make_multibyte_string (buf, SCHARS (string), nbytes); - SAFE_FREE (nbytes); + SAFE_FREE (); return ret; } @@ -1046,7 +1054,7 @@ string_to_multibyte (string) str_to_multibyte (buf, nbytes, SBYTES (string)); ret = make_multibyte_string (buf, SCHARS (string), nbytes); - SAFE_FREE (nbytes); + SAFE_FREE (); return ret; } @@ -1073,7 +1081,7 @@ string_make_unibyte (string) 1, 0); ret = make_unibyte_string (buf, nchars); - SAFE_FREE (nchars); + SAFE_FREE (); return ret; } @@ -1145,7 +1153,18 @@ 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'. */) +multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. +Beware, this often doesn't really do what you think it does. +It is similar to (decode-coding-string STRING 'emacs-mule-unix). +If you're not sure, whether to use `string-as-multibyte' or +`string-to-multibyte', use `string-to-multibyte'. Beware: + (aref (string-as-multibyte "\\201") 0) -> 129 (aka ?\\201) + (aref (string-as-multibyte "\\300") 0) -> 192 (aka ?\\300) + (aref (string-as-multibyte "\\300\\201") 0) -> 192 (aka ?\\300) + (aref (string-as-multibyte "\\300\\201") 1) -> 129 (aka ?\\201) +but + (aref (string-as-multibyte "\\201\\300") 0) -> 2240 + (aref (string-as-multibyte "\\201\\300") 1) -> */) (string) Lisp_Object string; { @@ -1179,7 +1198,8 @@ Otherwise it is a newly created string, with no text properties. Characters 0200 through 0237 are converted to eight-bit-control characters of the same character code. Characters 0240 through 0377 are converted to eight-bit-graphic characters of the same character -codes. */) +codes. +This is similar to (decode-coding-string STRING 'binary) */) (string) Lisp_Object string; { @@ -1456,7 +1476,7 @@ The value is actually the tail of LIST whose car is ELT. */) DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. -Comparison done with EQ. The value is actually the tail of LIST +Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. */) (elt, list) Lisp_Object elt, list; @@ -1877,8 +1897,8 @@ Lisp_Object merge (); DEFUN ("sort", Fsort, Ssort, 2, 2, 0, doc: /* Sort LIST, stably, comparing elements using PREDICATE. Returns the sorted list. LIST is modified by side effects. -PREDICATE is called with two elements of LIST, and should return t -if the first element is "less" than the second. */) +PREDICATE is called with two elements of LIST, and should return non-nil +if the first element should sort before the second. */) (list, predicate) Lisp_Object list, predicate; { @@ -1966,6 +1986,7 @@ merge (org_l1, org_l2, pred) } +#if 0 /* Unsafe version. */ DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, doc: /* Extract a value from a property list. PLIST is a property list, which is a list of the form @@ -1996,6 +2017,37 @@ one of the properties on the list. */) return Qnil; } +#endif + +/* This does not check for quits. That is safe since it must terminate. */ + +DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, + doc: /* Extract a value from a property list. +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. This function never signals an error. */) + (plist, prop) + Lisp_Object plist; + Lisp_Object prop; +{ + Lisp_Object tail, halftail; + + /* halftail is used to detect circular lists. */ + tail = halftail = plist; + while (CONSP (tail) && CONSP (XCDR (tail))) + { + if (EQ (prop, XCAR (tail))) + return XCAR (XCDR (tail)); + + tail = XCDR (XCDR (tail)); + halftail = XCDR (halftail); + if (EQ (tail, halftail)) + break; + } + + return Qnil; +} DEFUN ("get", Fget, Sget, 2, 2, 0, doc: /* Return the value of SYMBOL's PROPNAME property. @@ -2202,7 +2254,7 @@ internal_equal (o1, o2, depth, props) if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), depth + 1, props) || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), - depth + 1)) + depth + 1, props)) return 0; o1 = XOVERLAY (o1)->plist; o2 = XOVERLAY (o2)->plist; @@ -2370,7 +2422,9 @@ This makes STRING unibyte and may change its length. */) (string) Lisp_Object string; { - int len = SBYTES (string); + int len; + CHECK_STRING (string); + len = SBYTES (string); bzero (SDATA (string), len); STRING_SET_CHARS (string, len); STRING_SET_UNIBYTE (string); @@ -2459,50 +2513,143 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, return XCHAR_TABLE (char_table)->extras[XINT (n)] = value; } +static Lisp_Object +char_table_range (table, from, to, defalt) + Lisp_Object table; + int from, to; + Lisp_Object defalt; +{ + Lisp_Object val; + + if (! NILP (XCHAR_TABLE (table)->defalt)) + defalt = XCHAR_TABLE (table)->defalt; + val = XCHAR_TABLE (table)->contents[from]; + if (SUB_CHAR_TABLE_P (val)) + val = char_table_range (val, 32, 127, defalt); + else if (NILP (val)) + val = defalt; + for (from++; from <= to; from++) + { + Lisp_Object this_val; + + this_val = XCHAR_TABLE (table)->contents[from]; + if (SUB_CHAR_TABLE_P (this_val)) + this_val = char_table_range (this_val, 32, 127, defalt); + else if (NILP (this_val)) + this_val = defalt; + if (! EQ (val, this_val)) + error ("Characters in the range have inconsistent values"); + } + return val; +} + + 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) +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. */) +a character set name, or a character code. +If the characters in the specified range have different values, +an error is signaled. + +Note that this function doesn't check the parent of CHAR-TABLE. */) (char_table, range) Lisp_Object char_table, range; { + int charset_id, c1 = 0, c2 = 0; + int size; + Lisp_Object ch, val, current_default; + CHECK_CHAR_TABLE (char_table); if (EQ (range, Qnil)) return XCHAR_TABLE (char_table)->defalt; - else if (INTEGERP (range)) - return Faref (char_table, range); + if (INTEGERP (range)) + { + int c = XINT (range); + if (! CHAR_VALID_P (c, 0)) + error ("Invalid character code: %d", c); + ch = range; + SPLIT_CHAR (c, charset_id, c1, c2); + } else if (SYMBOLP (range)) { Lisp_Object charset_info; charset_info = Fget (range, Qcharset); CHECK_VECTOR (charset_info); - - return Faref (char_table, - make_number (XINT (XVECTOR (charset_info)->contents[0]) - + 128)); + charset_id = XINT (XVECTOR (charset_info)->contents[0]); + ch = Fmake_char_internal (make_number (charset_id), + make_number (0), make_number (0)); } else if (VECTORP (range)) { - if (XVECTOR (range)->size == 1) - return Faref (char_table, - make_number (XINT (XVECTOR (range)->contents[0]) + 128)); - else + size = ASIZE (range); + if (size == 0) + args_out_of_range (range, make_number (0)); + CHECK_NUMBER (AREF (range, 0)); + charset_id = XINT (AREF (range, 0)); + if (size > 1) { - 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); + CHECK_NUMBER (AREF (range, 1)); + c1 = XINT (AREF (range, 1)); + if (size > 2) + { + CHECK_NUMBER (AREF (range, 2)); + c2 = XINT (AREF (range, 2)); + } } + + /* This checks if charset_id, c0, and c1 are all valid or not. */ + ch = Fmake_char_internal (make_number (charset_id), + make_number (c1), make_number (c2)); } else error ("Invalid RANGE argument to `char-table-range'"); - return Qt; + + if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0)) + { + /* Fully specified character. */ + Lisp_Object parent = XCHAR_TABLE (char_table)->parent; + + XCHAR_TABLE (char_table)->parent = Qnil; + val = Faref (char_table, ch); + XCHAR_TABLE (char_table)->parent = parent; + return val; + } + + current_default = XCHAR_TABLE (char_table)->defalt; + if (charset_id == CHARSET_ASCII + || charset_id == CHARSET_8_BIT_CONTROL + || charset_id == CHARSET_8_BIT_GRAPHIC) + { + int from, to, defalt; + + if (charset_id == CHARSET_ASCII) + from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII; + else if (charset_id == CHARSET_8_BIT_CONTROL) + from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL; + else + from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC; + if (! NILP (XCHAR_TABLE (char_table)->contents[defalt])) + current_default = XCHAR_TABLE (char_table)->contents[defalt]; + return char_table_range (char_table, from, to, current_default); + } + + val = XCHAR_TABLE (char_table)->contents[128 + charset_id]; + if (! SUB_CHAR_TABLE_P (val)) + return (NILP (val) ? current_default : val); + if (! NILP (XCHAR_TABLE (val)->defalt)) + current_default = XCHAR_TABLE (val)->defalt; + if (c1 == 0) + return char_table_range (val, 32, 127, current_default); + val = XCHAR_TABLE (val)->contents[c1]; + if (! SUB_CHAR_TABLE_P (val)) + return (NILP (val) ? current_default : val); + if (! NILP (XCHAR_TABLE (val)->defalt)) + current_default = XCHAR_TABLE (val)->defalt; + return char_table_range (val, 32, 127, current_default); } DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, @@ -2520,7 +2667,14 @@ character set, or a character code. Return VALUE. */) if (EQ (range, Qt)) for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - XCHAR_TABLE (char_table)->contents[i] = value; + { + /* Don't set these special slots used for default values of + ascii, eight-bit-control, and eight-bit-graphic. */ + if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII + && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC) + XCHAR_TABLE (char_table)->contents[i] = value; + } else if (EQ (range, Qnil)) XCHAR_TABLE (char_table)->defalt = value; else if (SYMBOLP (range)) @@ -2551,19 +2705,12 @@ character set, or a character code. Return VALUE. */) 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); - } + 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]); + Faset (char_table, ch, value); } else error ("Invalid RANGE argument to `set-char-table-range'"); @@ -2575,6 +2722,8 @@ 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 generic character CH to VALUE. The generic character specifies the group of characters. +If CH is a normal character, set the default value for a group of +characters to which CH belongs. See also the documentation of `make-char'. */) (char_table, ch, value) Lisp_Object char_table, ch, value; @@ -2594,27 +2743,34 @@ See also the documentation of `make-char'. */) if (! CHARSET_VALID_P (charset)) invalid_character (c); - if (charset == CHARSET_ASCII) - return (XCHAR_TABLE (char_table)->defalt = value); + if (SINGLE_BYTE_CHAR_P (c)) + { + /* We use special slots for the default values of single byte + characters. */ + int default_slot + = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII + : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); + + return (XCHAR_TABLE (char_table)->contents[default_slot] = 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 (! SUB_CHAR_TABLE_P (temp)) + { + temp = make_sub_char_table (temp); + XCHAR_TABLE (char_table)->contents[charset + 128] = temp; + } if (!code1) { - if (SUB_CHAR_TABLE_P (temp)) - XCHAR_TABLE (temp)->defalt = value; - else - XCHAR_TABLE (char_table)->contents[charset + 128] = value; + XCHAR_TABLE (temp)->defalt = 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)); + char_table = temp; temp = XCHAR_TABLE (char_table)->contents[code1]; if (SUB_CHAR_TABLE_P (temp)) XCHAR_TABLE (temp)->defalt = value; @@ -2703,6 +2859,9 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) int depth; { int i, to; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + GCPRO4 (arg, table, subtable, function); if (depth == 0) { @@ -2722,7 +2881,10 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) #if 0 /* If the char table has entries for higher characters, we should report them. */ if (NILP (current_buffer->enable_multibyte_characters)) - return; + { + UNGCPRO; + return; + } #endif to = CHAR_TABLE_ORDINARY_SLOTS; } @@ -2775,6 +2937,7 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) call2 (function, make_number (c), elt); } } + UNGCPRO; } static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c)); @@ -2974,9 +3137,9 @@ mapcar1 (leni, vals, fn, seq) else /* Must be a list, since Flength did not get an error */ { tail = seq; - for (i = 0; i < leni; i++) + for (i = 0; i < leni && CONSP (tail); i++) { - dummy = call1 (fn, Fcar (tail)); + dummy = call1 (fn, XCAR (tail)); if (vals) vals[i] = dummy; tail = XCDR (tail); @@ -3000,7 +3163,6 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) register Lisp_Object *args; register int i; struct gcpro gcpro1; - int nbytes; Lisp_Object ret; USE_SAFE_ALLOCA; @@ -3009,21 +3171,20 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) nargs = leni + leni - 1; if (nargs < 0) return build_string (""); - nbytes = nargs * sizeof (Lisp_Object); - SAFE_ALLOCA (args, Lisp_Object *, nbytes); + SAFE_ALLOCA_LISP (args, nargs); GCPRO1 (separator); mapcar1 (leni, args, function, sequence); UNGCPRO; - for (i = leni - 1; i >= 0; i--) + for (i = leni - 1; i > 0; i--) args[i + i] = args[i]; for (i = 1; i < nargs; i += 2) args[i] = separator; ret = Fconcat (nargs, args); - SAFE_FREE (nbytes); + SAFE_FREE (); return ret; } @@ -3038,20 +3199,18 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) register Lisp_Object len; register int leni; register Lisp_Object *args; - int nbytes; Lisp_Object ret; USE_SAFE_ALLOCA; len = Flength (sequence); leni = XFASTINT (len); - nbytes = leni * sizeof (Lisp_Object); - SAFE_ALLOCA (args, Lisp_Object *, nbytes); + SAFE_ALLOCA_LISP (args, leni); mapcar1 (leni, args, function, sequence); ret = Flist (leni, args); - SAFE_FREE(nbytes); + SAFE_FREE (); return ret; } @@ -3122,7 +3281,7 @@ is nil and `use-dialog-box' is non-nil. */) Fcons (Fcons (build_string ("No"), Qnil), Qnil)); menu = Fcons (prompt, pane); - obj = Fx_popup_dialog (Qt, menu); + obj = Fx_popup_dialog (Qt, menu, Qnil); answer = !NILP (obj); break; } @@ -3254,7 +3413,7 @@ is nil, and `use-dialog-box' is non-nil. */) Qnil)); GCPRO1 (pane); menu = Fcons (prompt, pane); - obj = Fx_popup_dialog (Qt, menu); + obj = Fx_popup_dialog (Qt, menu, Qnil); UNGCPRO; return obj; } @@ -3270,7 +3429,7 @@ 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)); + Qnil, Qnil)); if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) { UNGCPRO; @@ -3359,7 +3518,8 @@ particular subfeatures supported in this version of FEATURE. */) CHECK_SYMBOL (feature); CHECK_LIST (subfeatures); if (!NILP (Vautoload_queue)) - Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); + Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures), + Vautoload_queue); tem = Fmemq (feature, Vfeatures); if (NILP (tem)) Vfeatures = Fcons (feature, Vfeatures); @@ -3404,9 +3564,25 @@ The normal messages at start and end of loading FILENAME are suppressed. */) { register Lisp_Object tem; struct gcpro gcpro1, gcpro2; + int from_file = load_in_progress; CHECK_SYMBOL (feature); + /* Record the presence of `require' in this file + even if the feature specified is already loaded. + But not more than once in any file, + and not when we aren't loading or reading from a file. */ + if (!from_file) + for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem)) + if (NILP (XCDR (tem)) && STRINGP (XCAR (tem))) + from_file = 1; + + if (from_file) + { + tem = Fcons (Qrequire, feature); + if (NILP (Fmember (tem, Vcurrent_load_list))) + LOADHIST_ATTACH (tem); + } tem = Fmemq (feature, Vfeatures); if (NILP (tem)) @@ -3414,8 +3590,6 @@ The normal messages at start and end of loading FILENAME are suppressed. */) 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)) @@ -3758,7 +3932,7 @@ into shorter lines. */) if (encoded_length < 0) { /* The encoding wasn't possible. */ - SAFE_FREE (allength); + SAFE_FREE (); error ("Multibyte character in data for base64 encoding"); } @@ -3766,7 +3940,7 @@ into shorter lines. */) and delete the old. (Insert first in order to preserve markers.) */ SET_PT_BOTH (XFASTINT (beg), ibeg); insert (encoded, encoded_length); - SAFE_FREE (allength); + SAFE_FREE (); del_range_byte (ibeg + encoded_length, iend + encoded_length, 1); /* If point was outside of the region, restore it exactly; else just @@ -3815,12 +3989,12 @@ into shorter lines. */) if (encoded_length < 0) { /* The encoding wasn't possible. */ - SAFE_FREE (allength); + SAFE_FREE (); error ("Multibyte character in data for base64 encoding"); } encoded_string = make_unibyte_string (encoded, encoded_length); - SAFE_FREE (allength); + SAFE_FREE (); return encoded_string; } @@ -3957,7 +4131,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ if (decoded_length < 0) { /* The decoding wasn't possible. */ - SAFE_FREE (allength); + SAFE_FREE (); error ("Invalid base64 data"); } @@ -3965,7 +4139,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ and delete the old. (Insert first in order to preserve markers.) */ TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); - SAFE_FREE (allength); + SAFE_FREE (); /* Delete the original text. */ del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars, @@ -4009,7 +4183,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, else decoded_string = Qnil; - SAFE_FREE (length); + SAFE_FREE (); if (!STRINGP (decoded_string)) error ("Invalid base64 data"); @@ -4798,6 +4972,10 @@ sweep_weak_table (h, remove_entries_p) h->count = make_number (XFASTINT (h->count) - 1); } + else + { + prev = idx; + } } else { @@ -4940,6 +5118,12 @@ sxhash_list (list, depth) hash = SXHASH_COMBINE (hash, hash2); } + if (!NILP (list)) + { + unsigned hash2 = sxhash (list, depth + 1); + hash = SXHASH_COMBINE (hash, hash2); + } + return hash; } @@ -5002,15 +5186,14 @@ sxhash (obj, depth) hash = XUINT (obj); break; - case Lisp_Symbol: - hash = sxhash_string (SDATA (SYMBOL_NAME (obj)), - SCHARS (SYMBOL_NAME (obj))); - break; - case Lisp_Misc: hash = XUINT (obj); break; + case Lisp_Symbol: + obj = SYMBOL_NAME (obj); + /* Fall through. */ + case Lisp_String: hash = sxhash_string (SDATA (obj), SCHARS (obj)); break; @@ -5321,7 +5504,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, doc: /* Call FUNCTION for all entries in hash table TABLE. -FUNCTION is called with 2 arguments KEY and VALUE. */) +FUNCTION is called with two arguments, KEY and VALUE. */) (function, table) Lisp_Object function, table; { @@ -5667,7 +5850,7 @@ syms_of_fns () DEFVAR_LISP ("features", &Vfeatures, doc: /* A list of symbols which are the features of the executing emacs. Used by `featurep' and `require', and altered by `provide'. */); - Vfeatures = Qnil; + Vfeatures = Fcons (intern ("emacs"), Qnil); Qsubfeatures = intern ("subfeatures"); staticpro (&Qsubfeatures);