/* 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, 2002
Free Software Foundation, Inc.
This file is part of GNU Emacs.
so make sure we don't use that name in this file. */
#undef vector
#define vector *****
-
#include "lisp.h"
#include "commands.h"
#include "charset.h"
-
+#include "coding.h"
#include "buffer.h"
#include "keyboard.h"
#include "keymap.h"
#endif
#ifndef NULL
-#define NULL (void *)0
+#define NULL ((POINTER_TYPE *)0)
#endif
/* Nonzero enables use of dialog boxes for questions
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;
#endif
\f
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
- doc: /* Return the argument unchanged. */)
+ doc: /* Return the argument unchanged. */)
(arg)
Lisp_Object arg;
{
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)
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))
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);
- return make_number (STRING_BYTES (XSTRING (string)));
+ return make_number (SBYTES (string));
}
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
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);
+ 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;
}
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);
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);
}
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);
}
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);
+ 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)
{
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
- return i1 < XSTRING (s2)->size ? Qt : Qnil;
+ return i1 < SCHARS (s2) ? Qt : Qnil;
}
\f
static Lisp_Object concat ();
return concat (nargs, args, Lisp_Vectorlike, 0);
}
-/* Retrun a copy of a sub char table ARG. The elements except for a
+/* Return 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)
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)
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));
}
}
if (STRINGP (this) && STRINGP (val)
&& STRING_MULTIBYTE (this) == some_multibyte)
{
- int thislen_byte = STRING_BYTES (XSTRING (this));
+ int thislen_byte = SBYTES (this);
int combined;
- bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
- STRING_BYTES (XSTRING (this)));
+ bcopy (SDATA (this), SDATA (val) + toindex_byte,
+ SBYTES (this));
combined = (some_multibyte && toindex_byte > 0
- ? count_combining (XSTRING (val)->data,
+ ? count_combining (SDATA (val),
toindex_byte + thislen_byte,
toindex_byte)
: 0);
- if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
+ if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
{
textprops[num_textprops].argnum = argnum;
/* We ignore text properties on characters being combined. */
}
toindex_byte += thislen_byte;
toindex += thisleni - combined;
- XSTRING (val)->size -= combined;
+ STRING_SET_CHARS (val, SCHARS (val) - combined);
}
/* 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
}
else
{
- XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
+ XSETFASTINT (elt, SREF (this, thisindex++));
if (some_multibyte
&& (XINT (elt) >= 0240
|| (XINT (elt) >= 0200
if (some_multibyte)
toindex_byte
+= CHAR_STRING (XINT (elt),
- XSTRING (val)->data + toindex_byte);
+ SDATA (val) + toindex_byte);
else
- XSTRING (val)->data[toindex_byte++] = XINT (elt);
+ SSET (val, toindex_byte++, XINT (elt));
if (some_multibyte
&& toindex_byte > 0
- && count_combining (XSTRING (val)->data,
+ && count_combining (SDATA (val),
toindex_byte, toindex_byte - 1))
- XSTRING (val)->size--;
+ STRING_SET_CHARS (val, SCHARS (val) - 1);
else
toindex++;
}
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];
+ unsigned char *p = SDATA (val) + toindex_byte;
toindex_byte += CHAR_STRING (c, p);
toindex++;
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. */
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;
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))
{
{
while (best_above > char_index)
{
- unsigned char *pend = XSTRING (string)->data + best_above_byte;
+ unsigned char *pend = SDATA (string) + best_above_byte;
unsigned char *pbeg = pend - best_above_byte;
unsigned char *p = pend - 1;
int bytes;
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))
{
{
while (best_above_byte > byte_index)
{
- unsigned char *pend = XSTRING (string)->data + best_above_byte;
+ unsigned char *pend = SDATA (string) + best_above_byte;
unsigned char *pbeg = pend - best_above_byte;
unsigned char *p = pend - 1;
int bytes;
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 to a multibyte string without changing each
+ character codes. Thus, characters 0200 trough 0237 are converted
+ to eight-bit-control characters, and characters 0240 through 0377
+ are converted eight-bit-graphic 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 or eight-bit-graphic, 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
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,
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;
{
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);
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.
+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-control characters of the same character
+codes. */)
+ (string)
+ Lisp_Object string;
+{
+ CHECK_STRING (string);
+
+ return string_to_multibyte (string);
+}
+
\f
DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
doc: /* Return a copy of ALIST.
}
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)
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;
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),
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. */
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;
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),
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;
}
}
}
- 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;
}
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;
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;
Lisp_Object prop;
{
Lisp_Object tail;
-
+
for (tail = plist;
CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
if (!NILP (tail))
wrong_type_argument (Qlistp, prop);
-
+
return Qnil;
}
Fsetcar (XCDR (tail), val);
return plist;
}
-
+
prev = tail;
QUIT;
}
= Fplist_put (XSYMBOL (symbol)->plist, propname, value);
return value;
}
+\f
+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;
+}
+\f
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.
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;
case Lisp_Type_Limit:
break;
}
-
+
return 0;
}
\f
}
else if (STRINGP (array))
{
- register unsigned char *p = XSTRING (array)->data;
+ 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;
}
}
+static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
+static void
+void_call2 (a, b, c)
+ Lisp_Object a, b, c;
+{
+ call2 (a, b, c);
+}
+
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.
CHECK_CHAR_TABLE (char_table);
- map_char_table (NULL, function, char_table, char_table, 0, indices);
+ /* When Lisp_Object is represented as a union, `call2' cannot directly
+ be passed to map_char_table because it returns a Lisp_Object rather
+ than returning nothing.
+ Casting leads to crashes on some architectures. -stef */
+ map_char_table (void_call2, Qnil, char_table, function, 0, indices);
return Qnil;
}
while (CONSP (tem))
{
tail = tem;
- tem = Fcdr (tail);
+ tem = XCDR (tail);
QUIT;
}
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);
#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)
{
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;
\f
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.
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
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;
}
{
register Lisp_Object tem;
CHECK_SYMBOL (feature);
+ CHECK_LIST (subfeatures);
if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
tem = Fmemq (feature, Vfeatures);
/* 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;
}
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. */
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);
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;
UNGCPRO;
return result;
}
+
+#ifdef HAVE_LANGINFO_CODESET
+#include <langinfo.h>
+#endif
+
+DEFUN ("langinfo", Flanginfo, Slanginfo, 1, 1, 0,
+ doc: /* Access locale data ITEM, if available.
+
+ITEM may 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,
+ where the width and height are in mm (locale items PAPER_WIDTH,
+ PAPER_HEIGHT).
+
+If the system can't provide such information through a call to
+nl_langinfo(3), 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;
+}
\f
/* base64 encode/decode functions (RFC 2045).
Based on code from GNU recode. */
/* 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;
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)
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);
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 ();
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;
{
h = XHASH_TABLE (table);
next = h->next_weak;
-
+
if (h->size & ARRAY_MARK_FLAG)
{
/* TABLE is marked as used. Sweep its contents. */
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:
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. */
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:
/* 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));
}
-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)
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.
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.
if (STRING_MULTIBYTE (object))
/* use default, we can't guess correct value */
coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));
- else
+ else
coding_system = Qraw_text;
}
-
+
if (NILP (Fcoding_system_p (coding_system)))
{
/* Invalid coding system. */
-
+
if (!NILP (noerror))
coding_system = Qraw_text;
else
if (STRING_MULTIBYTE (object))
object = code_convert_string1 (object, coding_system, Qnil, 1);
- size = XSTRING (object)->size;
- size_byte = STRING_BYTES (XSTRING (object));
+ size = SCHARS (object);
+ size_byte = SBYTES (object);
if (!NILP (start))
{
else
{
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));
CHECK_BUFFER (object);
bp = XBUFFER (object);
-
+
if (NILP (start))
b = BUF_BEGV (bp);
else
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))
{
/* 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);
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;
object = code_convert_string1 (object, coding_system, Qnil, 1);
}
- 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++)
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);
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;
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);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);
+ defsubr (&Slax_plist_get);
+ defsubr (&Slax_plist_put);
defsubr (&Sequal);
defsubr (&Sfillarray);
defsubr (&Schar_table_subtype);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
+ defsubr (&Slanginfo);
}