/* Random utility Lisp functions.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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. */
{
Lisp_Object val;
int size_in_chars
- = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+ = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
val = Fmake_bool_vector (Flength (arg), Qnil);
bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}
-/* 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.
- Otherwize, return 0. */
-
-static int
-count_combining (str, len, i)
- unsigned char *str;
- int len, i;
-{
- int j = i - 1, bytes;
-
- if (i == 0 || i == len || CHAR_HEAD_P (str[i]))
- return 0;
- while (j >= 0 && !CHAR_HEAD_P (str[j])) j--;
- if (j < 0 || ! BASE_LEADING_CODE_P (str[j]))
- return 0;
- PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes);
- return (bytes <= i - j ? 0 : bytes - (i - j));
-}
-
/* This structure holds information of an argument of `concat' that is
a string and has text properties to be copied. */
struct textprop_rec
struct textprop_rec *textprops = NULL;
/* Number of elments in textprops. */
int num_textprops = 0;
+ USE_SAFE_ALLOCA;
tail = Qnil;
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++)
{
&& STRING_MULTIBYTE (this) == some_multibyte)
{
int thislen_byte = SBYTES (this);
- int combined;
bcopy (SDATA (this), SDATA (val) + toindex_byte,
SBYTES (this));
- combined = (some_multibyte && toindex_byte > 0
- ? count_combining (SDATA (val),
- toindex_byte + thislen_byte,
- toindex_byte)
- : 0);
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;
- STRING_SET_CHARS (val, SCHARS (val) - combined);
+ toindex += thisleni;
+ STRING_SET_CHARS (val, SCHARS (val));
}
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
}
else
{
- XSETFASTINT (elt, SREF (this, thisindex++));
+ XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
if (some_multibyte
&& (XINT (elt) >= 0240
|| (XINT (elt) >= 0200
else if (BOOL_VECTOR_P (this))
{
int byte;
- byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR];
- if (byte & (1 << (thisindex % BITS_PER_CHAR)))
+ byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
+ if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
elt = Qt;
else
elt = Qnil;
SDATA (val) + toindex_byte);
else
SSET (val, toindex_byte++, XINT (elt));
- if (some_multibyte
- && toindex_byte > 0
- && count_combining (SDATA (val),
- toindex_byte, toindex_byte - 1))
- STRING_SET_CHARS (val, SCHARS (val) - 1);
- else
- toindex++;
+ toindex++;
}
else
/* If we have any multibyte characters,
last_to_end = textprops[argnum].to + SCHARS (this);
}
}
+
+ SAFE_FREE ();
return val;
}
\f
{
unsigned char *buf;
int nbytes;
+ Lisp_Object ret;
+ USE_SAFE_ALLOCA;
if (STRING_MULTIBYTE (string))
return string;
if (nbytes == SBYTES (string))
return string;
- buf = (unsigned char *) alloca (nbytes);
+ SAFE_ALLOCA (buf, unsigned char *, nbytes);
copy_text (SDATA (string), buf, SBYTES (string),
0, 1);
- return make_multibyte_string (buf, SCHARS (string), nbytes);
+ ret = make_multibyte_string (buf, SCHARS (string), nbytes);
+ SAFE_FREE ();
+
+ return ret;
}
{
unsigned char *buf;
int nbytes;
+ Lisp_Object ret;
+ USE_SAFE_ALLOCA;
if (STRING_MULTIBYTE (string))
return string;
if (nbytes == SBYTES (string))
return make_multibyte_string (SDATA (string), nbytes, nbytes);
- buf = (unsigned char *) alloca (nbytes);
+ SAFE_ALLOCA (buf, unsigned char *, nbytes);
bcopy (SDATA (string), buf, SBYTES (string));
str_to_multibyte (buf, nbytes, SBYTES (string));
- return make_multibyte_string (buf, SCHARS (string), nbytes);
+ ret = make_multibyte_string (buf, SCHARS (string), nbytes);
+ SAFE_FREE ();
+
+ return ret;
}
string_make_unibyte (string)
Lisp_Object string;
{
+ int nchars;
unsigned char *buf;
+ Lisp_Object ret;
+ USE_SAFE_ALLOCA;
if (! STRING_MULTIBYTE (string))
return string;
- buf = (unsigned char *) alloca (SCHARS (string));
+ nchars = SCHARS (string);
+ SAFE_ALLOCA (buf, unsigned char *, nchars);
copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
- return make_unibyte_string (buf, SCHARS (string));
+ ret = make_unibyte_string (buf, nchars);
+ SAFE_FREE ();
+
+ return ret;
}
DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
The value is actually the first element of LIST whose car equals KEY. */)
- (key, list)
+ (key, list)
Lisp_Object key, list;
{
Lisp_Object result, car;
return Qnil;
}
+DEFUN ("safe-plist-get", Fsafe_plist_get, Ssafe_plist_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.
This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
return plist;
}
\f
+DEFUN ("eql", Feql, Seql, 2, 2, 0,
+ doc: /* Return t if the two args are the same Lisp object.
+Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
+ (obj1, obj2)
+ Lisp_Object obj1, obj2;
+{
+ if (FLOATP (obj1))
+ return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
+ else
+ return EQ (obj1, obj2) ? Qt : Qnil;
+}
+
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.
if (BOOL_VECTOR_P (o1))
{
int size_in_chars
- = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+ = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
return 0;
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
int size_in_chars
- = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+ = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
charval = (! NILP (item) ? -1 : 0);
for (index = 0; index < size_in_chars - 1; index++)
if (index < size_in_chars)
{
/* Mask out bits beyond the vector size. */
- if (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)
- charval &= (1 << (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)) - 1;
+ if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
+ charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
p[index] = charval;
}
}
(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);
int depth;
{
int i, to;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ GCPRO4 (arg, table, subtable, function);
if (depth == 0)
{
#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;
}
call2 (function, make_number (c), elt);
}
}
+ UNGCPRO;
}
static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
for (i = 0; i < leni; i++)
{
int byte;
- byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR];
- if (byte & (1 << (i % BITS_PER_CHAR)))
+ byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
+ if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)))
dummy = Qt;
else
dummy = Qnil;
register Lisp_Object *args;
register int i;
struct gcpro gcpro1;
+ Lisp_Object ret;
+ USE_SAFE_ALLOCA;
len = Flength (sequence);
leni = XINT (len);
nargs = leni + leni - 1;
if (nargs < 0) return build_string ("");
- args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (args, nargs);
GCPRO1 (separator);
mapcar1 (leni, args, function, sequence);
for (i = 1; i < nargs; i += 2)
args[i] = separator;
- return Fconcat (nargs, args);
+ ret = Fconcat (nargs, args);
+ SAFE_FREE ();
+
+ return ret;
}
DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
register Lisp_Object len;
register int leni;
register Lisp_Object *args;
+ Lisp_Object ret;
+ USE_SAFE_ALLOCA;
len = Flength (sequence);
leni = XFASTINT (len);
- args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
+
+ SAFE_ALLOCA_LISP (args, leni);
mapcar1 (leni, args, function, sequence);
- return Flist (leni, args);
+ ret = Flist (leni, args);
+ SAFE_FREE ();
+
+ return ret;
}
DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
{
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;
} \
while (IS_BASE64_IGNORABLE (c))
-/* Don't use alloca for regions larger than this, lest we overflow
- their stack. */
-#define MAX_ALLOCA 16*1024
-
/* Table of characters coding the 64 values. */
static char base64_value_to_char[64] =
{
int allength, length;
int ibeg, iend, encoded_length;
int old_pos = PT;
+ USE_SAFE_ALLOCA;
validate_region (&beg, &end);
allength = length + length/3 + 1;
allength += allength / MIME_LINE_LENGTH + 1 + 6;
- if (allength <= MAX_ALLOCA)
- encoded = (char *) alloca (allength);
- else
- encoded = (char *) xmalloc (allength);
+ SAFE_ALLOCA (encoded, char *, allength);
encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length,
NILP (no_line_break),
!NILP (current_buffer->enable_multibyte_characters));
if (encoded_length < 0)
{
/* The encoding wasn't possible. */
- if (length > MAX_ALLOCA)
- xfree (encoded);
+ SAFE_FREE ();
error ("Multibyte character in data for base64 encoding");
}
and delete the old. (Insert first in order to preserve markers.) */
SET_PT_BOTH (XFASTINT (beg), ibeg);
insert (encoded, encoded_length);
- if (allength > MAX_ALLOCA)
- xfree (encoded);
+ SAFE_FREE ();
del_range_byte (ibeg + encoded_length, iend + encoded_length, 1);
/* If point was outside of the region, restore it exactly; else just
int allength, length, encoded_length;
char *encoded;
Lisp_Object encoded_string;
+ USE_SAFE_ALLOCA;
CHECK_STRING (string);
allength += allength / MIME_LINE_LENGTH + 1 + 6;
/* We need to allocate enough room for decoding the text. */
- if (allength <= MAX_ALLOCA)
- encoded = (char *) alloca (allength);
- else
- encoded = (char *) xmalloc (allength);
+ SAFE_ALLOCA (encoded, char *, allength);
encoded_length = base64_encode_1 (SDATA (string),
encoded, length, NILP (no_line_break),
if (encoded_length < 0)
{
/* The encoding wasn't possible. */
- if (length > MAX_ALLOCA)
- xfree (encoded);
+ SAFE_FREE ();
error ("Multibyte character in data for base64 encoding");
}
encoded_string = make_unibyte_string (encoded, encoded_length);
- if (allength > MAX_ALLOCA)
- xfree (encoded);
+ SAFE_FREE ();
return encoded_string;
}
int decoded_length;
int inserted_chars;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
+ USE_SAFE_ALLOCA;
validate_region (&beg, &end);
working on a multibyte buffer, each decoded code may occupy at
most two bytes. */
allength = multibyte ? length * 2 : length;
- if (allength <= MAX_ALLOCA)
- decoded = (char *) alloca (allength);
- else
- decoded = (char *) xmalloc (allength);
+ SAFE_ALLOCA (decoded, char *, allength);
move_gap_both (XFASTINT (beg), ibeg);
decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length,
if (decoded_length < 0)
{
/* The decoding wasn't possible. */
- if (allength > MAX_ALLOCA)
- xfree (decoded);
+ SAFE_FREE ();
error ("Invalid base64 data");
}
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);
- if (allength > MAX_ALLOCA)
- xfree (decoded);
+ SAFE_FREE ();
+
/* Delete the original text. */
del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
iend + decoded_length, 1);
char *decoded;
int length, decoded_length;
Lisp_Object decoded_string;
+ USE_SAFE_ALLOCA;
CHECK_STRING (string);
length = SBYTES (string);
/* We need to allocate enough room for decoding the text. */
- if (length <= MAX_ALLOCA)
- decoded = (char *) alloca (length);
- else
- decoded = (char *) xmalloc (length);
+ SAFE_ALLOCA (decoded, char *, length);
/* The decoded result should be unibyte. */
decoded_length = base64_decode_1 (SDATA (string), decoded, length,
else
decoded_string = Qnil;
- if (length > MAX_ALLOCA)
- xfree (decoded);
+ SAFE_FREE ();
if (!STRINGP (decoded_string))
error ("Invalid base64 data");
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;
defsubr (&Sreverse);
defsubr (&Ssort);
defsubr (&Splist_get);
+ defsubr (&Ssafe_plist_get);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);
defsubr (&Slax_plist_get);
defsubr (&Slax_plist_put);
+ defsubr (&Seql);
defsubr (&Sequal);
defsubr (&Sequal_including_properties);
defsubr (&Sfillarray);