#endif
\f
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
- doc: /* Return the argument unchanged. */)
+ doc: /* Return the argument unchanged. */)
(arg)
Lisp_Object arg;
{
(string)
Lisp_Object string;
{
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
return make_number (STRING_BYTES (XSTRING (string)));
}
register Lisp_Object s1, s2;
{
if (SYMBOLP (s1))
- XSETSTRING (s1, XSYMBOL (s1)->name);
+ s1 = SYMBOL_NAME (s1);
if (SYMBOLP (s2))
- XSETSTRING (s2, XSYMBOL (s2)->name);
- CHECK_STRING (s1, 0);
- CHECK_STRING (s2, 1);
+ s2 = SYMBOL_NAME (s2);
+ CHECK_STRING (s1);
+ CHECK_STRING (s2);
if (XSTRING (s1)->size != XSTRING (s2)->size
|| STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))
register int end1_char, end2_char;
register int i1, i1_byte, i2, i2_byte;
- CHECK_STRING (str1, 0);
- CHECK_STRING (str2, 1);
+ CHECK_STRING (str1);
+ CHECK_STRING (str2);
if (NILP (start1))
start1 = make_number (0);
if (NILP (start2))
start2 = make_number (0);
- CHECK_NATNUM (start1, 2);
- CHECK_NATNUM (start2, 3);
+ CHECK_NATNUM (start1);
+ CHECK_NATNUM (start2);
if (! NILP (end1))
- CHECK_NATNUM (end1, 4);
+ CHECK_NATNUM (end1);
if (! NILP (end2))
- CHECK_NATNUM (end2, 4);
+ CHECK_NATNUM (end2);
i1 = XINT (start1);
i2 = XINT (start2);
register int i1, i1_byte, i2, i2_byte;
if (SYMBOLP (s1))
- XSETSTRING (s1, XSYMBOL (s1)->name);
+ s1 = SYMBOL_NAME (s1);
if (SYMBOLP (s2))
- XSETSTRING (s2, XSYMBOL (s2)->name);
- CHECK_STRING (s1, 0);
- CHECK_STRING (s2, 1);
+ s2 = SYMBOL_NAME (s2);
+ CHECK_STRING (s1);
+ CHECK_STRING (s2);
i1 = i1_byte = i2 = i2_byte = 0;
XVECTOR (val)->contents[toindex++] = elt;
else
{
- CHECK_NUMBER (elt, 0);
+ CHECK_NUMBER (elt);
if (SINGLE_BYTE_CHAR_P (XINT (elt)))
{
if (some_multibyte)
(string)
Lisp_Object string;
{
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
return string_make_multibyte (string);
}
(string)
Lisp_Object string;
{
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
return string_make_unibyte (string);
}
(string)
Lisp_Object string;
{
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
if (STRING_MULTIBYTE (string))
{
(string)
Lisp_Object string;
{
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
if (! STRING_MULTIBYTE (string))
{
{
register Lisp_Object tem;
- CHECK_LIST (alist, 0);
+ CHECK_LIST (alist);
if (NILP (alist))
return alist;
alist = concat (1, &alist, Lisp_Cons, 0);
}
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.
if (! (STRINGP (string) || VECTORP (string)))
wrong_type_argument (Qarrayp, string);
- CHECK_NUMBER (from, 1);
+ CHECK_NUMBER (from);
if (STRINGP (string))
{
}
else
{
- CHECK_NUMBER (to, 2);
+ CHECK_NUMBER (to);
to_char = XINT (to);
if (to_char < 0)
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 = XSTRING (string)->size;
+ size_byte = STRING_BYTES (XSTRING (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 (XSTRING (string)->data + 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. */
register Lisp_Object list;
{
register int i, num;
- CHECK_NUMBER (n, 0);
+ CHECK_NUMBER (n);
num = XINT (n);
for (i = 0; i < num && !NILP (list); i++)
{
(sequence, n)
register Lisp_Object sequence, n;
{
- CHECK_NUMBER (n, 0);
+ CHECK_NUMBER (n);
while (1)
{
if (CONSP (sequence) || NILP (sequence))
}
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;
(symbol, propname)
Lisp_Object symbol, propname;
{
- CHECK_SYMBOL (symbol, 0);
+ CHECK_SYMBOL (symbol);
return Fplist_get (XSYMBOL (symbol)->plist, propname);
}
(symbol, propname, value)
Lisp_Object symbol, propname, value;
{
- CHECK_SYMBOL (symbol, 0);
+ CHECK_SYMBOL (symbol);
XSYMBOL (symbol)->plist
= Fplist_put (XSYMBOL (symbol)->plist, propname, value);
return value;
}
+\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.
else if (STRINGP (array))
{
register unsigned char *p = XSTRING (array)->data;
- CHECK_NUMBER (item, 1);
+ CHECK_NUMBER (item);
charval = XINT (item);
size = XSTRING (array)->size;
if (STRING_MULTIBYTE (array))
(char_table)
Lisp_Object char_table;
{
- CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_CHAR_TABLE (char_table);
return XCHAR_TABLE (char_table)->purpose;
}
(char_table)
Lisp_Object char_table;
{
- CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_CHAR_TABLE (char_table);
return XCHAR_TABLE (char_table)->parent;
}
{
Lisp_Object temp;
- CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_CHAR_TABLE (char_table);
if (!NILP (parent))
{
- CHECK_CHAR_TABLE (parent, 0);
+ CHECK_CHAR_TABLE (parent);
for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
if (EQ (temp, char_table))
(char_table, n)
Lisp_Object char_table, n;
{
- CHECK_CHAR_TABLE (char_table, 1);
- CHECK_NUMBER (n, 2);
+ CHECK_CHAR_TABLE (char_table);
+ CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
(char_table, n, value)
Lisp_Object char_table, n, value;
{
- CHECK_CHAR_TABLE (char_table, 1);
- CHECK_NUMBER (n, 2);
+ CHECK_CHAR_TABLE (char_table);
+ CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
(char_table, range)
Lisp_Object char_table, range;
{
- CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_CHAR_TABLE (char_table);
if (EQ (range, Qnil))
return XCHAR_TABLE (char_table)->defalt;
Lisp_Object charset_info;
charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info, 0);
+ CHECK_VECTOR (charset_info);
return Faref (char_table,
make_number (XINT (XVECTOR (charset_info)->contents[0])
{
int i;
- CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_CHAR_TABLE (char_table);
if (EQ (range, Qt))
for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
Lisp_Object charset_info;
charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info, 0);
+ CHECK_VECTOR (charset_info);
return Faset (char_table,
make_number (XINT (XVECTOR (charset_info)->contents[0])
int c, charset, code1, code2;
Lisp_Object temp;
- CHECK_CHAR_TABLE (char_table, 0);
- CHECK_NUMBER (ch, 1);
+ CHECK_CHAR_TABLE (char_table);
+ CHECK_NUMBER (ch);
c = XINT (ch);
SPLIT_CHAR (c, charset, code1, code2);
int dim;
int i, j;
- CHECK_CHAR_TABLE (table, 0);
+ CHECK_CHAR_TABLE (table);
for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
{
/* The depth of char table is at most 3. */
Lisp_Object indices[3];
- CHECK_CHAR_TABLE (char_table, 1);
+ CHECK_CHAR_TABLE (char_table);
map_char_table (NULL, function, char_table, char_table, 0, indices);
return Qnil;
map = Fsymbol_value (intern ("query-replace-map"));
- CHECK_STRING (prompt, 0);
+ CHECK_STRING (prompt);
xprompt = prompt;
GCPRO2 (prompt, xprompt);
#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)
{
Lisp_Object args[2];
struct gcpro gcpro1;
- CHECK_STRING (prompt, 0);
+ CHECK_STRING (prompt);
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
Lisp_Object feature, subfeature;
{
register Lisp_Object tem;
- CHECK_SYMBOL (feature, 0);
+ CHECK_SYMBOL (feature);
tem = Fmemq (feature, Vfeatures);
if (!NILP (tem) && !NILP (subfeature))
- tem = Fmemq (subfeature, Fget (feature, Qsubfeatures));
+ tem = Fmember (subfeature, Fget (feature, Qsubfeatures));
return (NILP (tem)) ? Qnil : Qt;
}
Lisp_Object feature, subfeatures;
{
register Lisp_Object tem;
- CHECK_SYMBOL (feature, 0);
+ CHECK_SYMBOL (feature);
+ CHECK_LIST (subfeatures);
if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
tem = Fmemq (feature, Vfeatures);
register Lisp_Object tem;
struct gcpro gcpro1, gcpro2;
- CHECK_SYMBOL (feature, 0);
+ CHECK_SYMBOL (feature);
tem = Fmemq (feature, Vfeatures);
{
int count = specpdl_ptr - specpdl;
int nesting = 0;
+
+ /* 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",
+ XSTRING (SYMBOL_NAME (feature))->data);
/* A certain amount of recursive `require' is legitimate,
but if we require the same feature recursively 3 times,
}
if (nesting > 2)
error ("Recursive `require' for feature `%s'",
- XSYMBOL (feature)->name->data);
+ XSTRING (SYMBOL_NAME (feature))->data);
/* 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);
+ XSTRING (SYMBOL_NAME (feature))->data);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
(widget, property, value)
Lisp_Object widget, property, value;
{
- CHECK_CONS (widget, 1);
+ CHECK_CONS (widget);
XSETCDR (widget, Fplist_put (XCDR (widget), property, value));
return value;
}
{
if (NILP (widget))
return Qnil;
- CHECK_CONS (widget, 1);
+ CHECK_CONS (widget);
tmp = Fplist_member (XCDR (widget), property);
if (CONSP (tmp))
{
char *encoded;
Lisp_Object encoded_string;
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
/* We need to allocate enough room for encoding the text.
We need 33 1/3% more space, plus a newline every 76
int length, decoded_length;
Lisp_Object decoded_string;
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
length = STRING_BYTES (XSTRING (string));
/* We need to allocate enough room for decoding the text. */
check_hash_table (obj)
Lisp_Object obj;
{
- CHECK_HASH_TABLE (obj, 0);
+ CHECK_HASH_TABLE (obj);
return XHASH_TABLE (obj);
}
{
Lisp_Object table;
struct Lisp_Hash_Table *h2;
- struct Lisp_Vector *v, *next;
+ struct Lisp_Vector *next;
h2 = allocate_hash_table ();
next = h2->vec_next;
break;
case Lisp_Symbol:
- hash = sxhash_string (XSYMBOL (obj)->name->data,
- XSYMBOL (obj)->name->size);
+ hash = sxhash_string (XSTRING (SYMBOL_NAME (obj))->data,
+ XSTRING (SYMBOL_NAME (obj))->size);
break;
case Lisp_Misc:
Lisp_Object prop;
prop = Fget (test, Qhash_table_test);
- if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2)
+ if (!CONSP (prop) || !CONSP (XCDR (prop)))
Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
test));
- user_test = Fnth (make_number (0), prop);
- user_hash = Fnth (make_number (1), prop);
+ user_test = XCAR (prop);
+ user_hash = XCAR (XCDR (prop));
}
else
user_test = user_hash = Qnil;
if (!NILP (start))
{
- CHECK_NUMBER (start, 1);
+ CHECK_NUMBER (start);
start_char = XINT (start);
}
else
{
- CHECK_NUMBER (end, 2);
+ CHECK_NUMBER (end);
end_char = XINT (end);
}
else
{
- CHECK_BUFFER (object, 0);
+ CHECK_BUFFER (object);
bp = XBUFFER (object);
b = BUF_BEGV (bp);
else
{
- CHECK_NUMBER_COERCE_MARKER (start, 0);
+ CHECK_NUMBER_COERCE_MARKER (start);
b = XINT (start);
}
e = BUF_ZV (bp);
else
{
- CHECK_NUMBER_COERCE_MARKER (end, 1);
+ CHECK_NUMBER_COERCE_MARKER (end);
e = XINT (end);
}
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_as_unibyte);
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);
HCoop / bpt / emacs.git / blobdiff