/* 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.
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 <config.h>
#endif
#include <time.h>
-#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. */
#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
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;
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 ();
register Lisp_Object val;
register int i;
- retry:
if (STRINGP (sequence))
XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
QUIT;
}
- if (!NILP (sequence))
- wrong_type_argument (Qlistp, sequence);
+ CHECK_LIST_END (sequence, sequence);
val = make_number (i);
}
else if (NILP (sequence))
XSETFASTINT (val, 0);
else
- {
- sequence = wrong_type_argument (Qsequencep, sequence);
- goto retry;
- }
+ wrong_type_argument (Qsequencep, sequence);
+
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.
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));
}
if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
- arg = wrong_type_argument (Qsequencep, arg);
+ wrong_type_argument (Qsequencep, arg);
+
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}
struct textprop_rec *textprops = NULL;
/* Number of elments in textprops. */
int num_textprops = 0;
+ USE_SAFE_ALLOCA;
tail = Qnil;
else
last_tail = Qnil;
- /* Canonicalize each argument. */
+ /* Check each argument. */
for (argnum = 0; argnum < nargs; argnum++)
{
this = args[argnum];
if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
|| COMPILEDP (this) || BOOL_VECTOR_P (this)))
- {
- args[argnum] = wrong_type_argument (Qsequencep, this);
- }
+ wrong_type_argument (Qsequencep, this);
}
/* Compute total length in chars of arguments in RESULT_LEN.
for (i = 0; i < len; i++)
{
ch = XVECTOR (this)->contents[i];
- if (! INTEGERP (ch))
- wrong_type_argument (Qintegerp, ch);
+ CHECK_NUMBER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
for (; CONSP (this); this = XCDR (this))
{
ch = XCAR (this);
- if (! INTEGERP (ch))
- wrong_type_argument (Qintegerp, ch);
+ CHECK_NUMBER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
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++)
{
}
else
{
- XSETFASTINT (elt, SREF (this, thisindex++));
+ XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
if (some_multibyte
&& (XINT (elt) >= 0240
|| (XINT (elt) >= 0200
last_to_end = textprops[argnum].to + SCHARS (this);
}
}
+
+ SAFE_FREE ();
return val;
}
\f
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) -> <error> */)
(string)
Lisp_Object string;
{
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;
{
int from_char, to_char;
int from_byte = 0, to_byte = 0;
- if (! (STRINGP (string) || VECTORP (string)))
- wrong_type_argument (Qarrayp, string);
-
+ CHECK_VECTOR_OR_STRING (string);
CHECK_NUMBER (from);
if (STRINGP (string))
int size;
int size_byte;
- if (! (STRINGP (string) || VECTORP (string)))
- wrong_type_argument (Qarrayp, string);
+ CHECK_VECTOR_OR_STRING (string);
if (STRINGP (string))
{
for (i = 0; i < num && !NILP (list); i++)
{
QUIT;
- if (! CONSP (list))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (list, list);
list = XCDR (list);
}
return list;
register Lisp_Object sequence, n;
{
CHECK_NUMBER (n);
- while (1)
- {
- if (CONSP (sequence) || NILP (sequence))
- return Fcar (Fnthcdr (n, sequence));
- else if (STRINGP (sequence) || VECTORP (sequence)
- || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
- return Faref (sequence, n);
- else
- sequence = wrong_type_argument (Qsequencep, sequence);
- }
+ if (CONSP (sequence) || NILP (sequence))
+ return Fcar (Fnthcdr (n, sequence));
+
+ /* Faref signals a "not array" error, so check here. */
+ CHECK_ARRAY (sequence, Qsequencep);
+ return Faref (sequence, n);
}
DEFUN ("member", Fmember, Smember, 2, 2, 0,
for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
if (! NILP (Fequal (elt, tem)))
return tail;
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;
QUIT;
}
- if (!CONSP (list) && !NILP (list))
- list = wrong_type_argument (Qlistp, list);
-
+ CHECK_LIST (list);
return list;
}
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result;
-
while (1)
{
if (!CONSP (list)
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
/* Like Fassq but never report an error and do not allow quits.
|| !EQ (XCAR (XCAR (list)), key)))
list = XCDR (list);
- return CONSP (list) ? XCAR (list) : Qnil;
+ return CAR_SAFE (list);
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result, car;
+ Lisp_Object car;
while (1)
{
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
register Lisp_Object key;
Lisp_Object list;
{
- Lisp_Object result;
-
while (1)
{
if (!CONSP (list)
QUIT;
}
- if (NILP (list))
- result = Qnil;
- else if (CONSP (list))
- result = XCAR (list);
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
(key, list)
Lisp_Object key, list;
{
- Lisp_Object result, cdr;
+ Lisp_Object cdr;
while (1)
{
QUIT;
}
- if (CONSP (list))
- result = XCAR (list);
- else if (NILP (list))
- result = Qnil;
- else
- result = wrong_type_argument (Qlistp, list);
-
- return result;
+ return CAR (list);
}
\f
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
prev = Qnil;
while (!NILP (tail))
{
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
if (EQ (elt, tem))
{
for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
{
- if (!CONSP (tail))
- wrong_type_argument (Qlistp, seq);
+ CHECK_LIST_CONS (tail, seq);
if (!NILP (Fequal (elt, XCAR (tail))))
{
while (!NILP (tail))
{
QUIT;
- if (! CONSP (tail))
- wrong_type_argument (Qlistp, list);
+ CHECK_LIST_CONS (tail, list);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
QUIT;
new = Fcons (XCAR (list), new);
}
- if (!NILP (list))
- wrong_type_argument (Qconsp, list);
+ CHECK_LIST_END (list, list);
return new;
}
\f
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;
{
}
\f
+#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
QUIT;
}
- if (!NILP (tail))
- wrong_type_argument (Qlistp, prop);
+ CHECK_LIST_END (tail, prop);
return Qnil;
}
+#endif
-DEFUN ("safe-plist-get", Fsafe_plist_get, Ssafe_plist_get, 2, 2, 0,
+/* 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. */)
+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;
QUIT;
}
- if (!NILP (tail))
- wrong_type_argument (Qlistp, prop);
+ CHECK_LIST_END (tail, prop);
return Qnil;
}
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;
Lisp_Object array, item;
{
register int size, index, charval;
- retry:
if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
}
}
else
- {
- array = wrong_type_argument (Qarrayp, array);
- goto retry;
- }
+ wrong_type_argument (Qarrayp, array);
return array;
}
return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
}
\f
+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,
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))
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'");
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;
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;
if (argnum + 1 == nargs) break;
- if (!CONSP (tem))
- tem = wrong_type_argument (Qlistp, tem);
+ CHECK_LIST_CONS (tem, tem);
while (CONSP (tem))
{
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);
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)
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;
}
Fraise_frame (mini_frame);
}
- obj = read_filtered_event (1, 0, 0, 0);
+ obj = read_filtered_event (1, 0, 0, 0, Qnil);
cursor_in_echo_area = 0;
/* If we need to quit, quit with cursor_in_echo_area = 0. */
QUIT;
Qnil));
GCPRO1 (pane);
menu = Fcons (prompt, pane);
- obj = Fx_popup_dialog (Qt, menu);
+ obj = Fx_popup_dialog (Qt, menu, Qnil);
UNGCPRO;
return obj;
}
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);
{
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))
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))
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash code returned from \
-user-supplied hash function"),
- hash));
+ signal_error ("Invalid hash code returned from user-supplied hash function", hash);
return XUINT (hash);
}
h->count = make_number (XFASTINT (h->count) - 1);
}
+ else
+ {
+ prev = idx;
+ }
}
else
{
hash = SXHASH_COMBINE (hash, hash2);
}
+ if (!NILP (list))
+ {
+ unsigned hash2 = sxhash (list, depth + 1);
+ hash = SXHASH_COMBINE (hash, hash2);
+ }
+
return hash;
}
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
- test));
+ signal_error ("Invalid hash table test", test);
user_test = XCAR (prop);
user_hash = XCAR (XCDR (prop));
}
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));
+ signal_error ("Invalid hash table size", size);
/* Look for `:rehash-size SIZE'. */
i = get_key_arg (QCrehash_size, nargs, args, used);
if (!NUMBERP (rehash_size)
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
|| XFLOATINT (rehash_size) <= 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash size"),
- rehash_size));
+ signal_error ("Invalid hash table rehash size", rehash_size);
/* Look for `:rehash-threshold THRESHOLD'. */
i = get_key_arg (QCrehash_threshold, nargs, args, used);
if (!FLOATP (rehash_threshold)
|| XFLOATINT (rehash_threshold) <= 0.0
|| XFLOATINT (rehash_threshold) > 1.0)
- Fsignal (Qerror,
- list2 (build_string ("Invalid hash table rehash threshold"),
- rehash_threshold));
+ signal_error ("Invalid hash table rehash threshold", rehash_threshold);
/* Look for `:weakness WEAK'. */
i = get_key_arg (QCweakness, nargs, args, used);
&& !EQ (weak, Qvalue)
&& !EQ (weak, Qkey_or_value)
&& !EQ (weak, Qkey_and_value))
- Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
- weak));
+ signal_error ("Invalid hash table weakness", weak);
/* Now, all args should have been used up, or there's a problem. */
for (i = 0; i < nargs; ++i)
if (!used[i])
- Fsignal (Qerror,
- list2 (build_string ("Invalid argument list"), args[i]));
+ signal_error ("Invalid argument list", args[i]);
return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
user_test, user_hash);
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;
{
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
if (STRING_MULTIBYTE (object))
if (!NILP (noerror))
coding_system = Qraw_text;
else
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ xsignal1 (Qcoding_system_error, coding_system);
}
}
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);
defsubr (&Sreverse);
defsubr (&Ssort);
defsubr (&Splist_get);
- defsubr (&Ssafe_plist_get);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);