1 |
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. |
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. |
2 |
Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001 |
Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2003 |
3 |
Free Software Foundation, Inc. |
Free Software Foundation, Inc. |
4 |
|
|
5 |
This file is part of GNU Emacs. |
This file is part of GNU Emacs. |
311 |
Lisp_Object object; |
Lisp_Object object; |
312 |
{ |
{ |
313 |
if (SYMBOLP (object) |
if (SYMBOLP (object) |
314 |
&& XSTRING (SYMBOL_NAME (object))->data[0] == ':' |
&& SREF (SYMBOL_NAME (object), 0) == ':' |
315 |
&& SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object)) |
&& SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object)) |
316 |
return Qt; |
return Qt; |
317 |
return Qnil; |
return Qnil; |
628 |
} |
} |
629 |
|
|
630 |
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, |
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, |
631 |
doc: /* Make SYMBOL's value be void. */) |
doc: /* Make SYMBOL's value be void. |
632 |
|
Return SYMBOL. */) |
633 |
(symbol) |
(symbol) |
634 |
register Lisp_Object symbol; |
register Lisp_Object symbol; |
635 |
{ |
{ |
641 |
} |
} |
642 |
|
|
643 |
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, |
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, |
644 |
doc: /* Make SYMBOL's function definition be void. */) |
doc: /* Make SYMBOL's function definition be void. |
645 |
|
Return SYMBOL. */) |
646 |
(symbol) |
(symbol) |
647 |
register Lisp_Object symbol; |
register Lisp_Object symbol; |
648 |
{ |
{ |
706 |
return definition; |
return definition; |
707 |
} |
} |
708 |
|
|
709 |
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, |
extern Lisp_Object Qfunction_documentation; |
710 |
|
|
711 |
|
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, |
712 |
doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. |
doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. |
713 |
Associates the function with the current load file, if any. */) |
Associates the function with the current load file, if any. |
714 |
(symbol, definition) |
The optional third argument DOCSTRING specifies the documentation string |
715 |
register Lisp_Object symbol, definition; |
for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string |
716 |
{ |
determined by DEFINITION. */) |
717 |
|
(symbol, definition, docstring) |
718 |
|
register Lisp_Object symbol, definition, docstring; |
719 |
|
{ |
720 |
|
if (CONSP (XSYMBOL (symbol)->function) |
721 |
|
&& EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) |
722 |
|
LOADHIST_ATTACH (Fcons (Qt, symbol)); |
723 |
definition = Ffset (symbol, definition); |
definition = Ffset (symbol, definition); |
724 |
LOADHIST_ATTACH (symbol); |
LOADHIST_ATTACH (symbol); |
725 |
|
if (!NILP (docstring)) |
726 |
|
Fput (symbol, Qfunction_documentation, docstring); |
727 |
return definition; |
return definition; |
728 |
} |
} |
729 |
|
|
795 |
hare = XSYMBOL (hare)->value; |
hare = XSYMBOL (hare)->value; |
796 |
if (!XSYMBOL (hare)->indirect_variable) |
if (!XSYMBOL (hare)->indirect_variable) |
797 |
break; |
break; |
798 |
|
|
799 |
hare = XSYMBOL (hare)->value; |
hare = XSYMBOL (hare)->value; |
800 |
tortoise = XSYMBOL (tortoise)->value; |
tortoise = XSYMBOL (tortoise)->value; |
801 |
|
|
881 |
*XINTFWD (valcontents)->intvar = XINT (newval); |
*XINTFWD (valcontents)->intvar = XINT (newval); |
882 |
if (*XINTFWD (valcontents)->intvar != XINT (newval)) |
if (*XINTFWD (valcontents)->intvar != XINT (newval)) |
883 |
error ("Value out of range for variable `%s'", |
error ("Value out of range for variable `%s'", |
884 |
XSTRING (SYMBOL_NAME (symbol))->data); |
SDATA (SYMBOL_NAME (symbol))); |
885 |
break; |
break; |
886 |
|
|
887 |
case Lisp_Misc_Boolfwd: |
case Lisp_Misc_Boolfwd: |
898 |
Lisp_Object type; |
Lisp_Object type; |
899 |
|
|
900 |
type = PER_BUFFER_TYPE (offset); |
type = PER_BUFFER_TYPE (offset); |
|
if (XINT (type) == -1) |
|
|
error ("Variable %s is read-only", XSTRING (SYMBOL_NAME (symbol))->data); |
|
|
|
|
901 |
if (! NILP (type) && ! NILP (newval) |
if (! NILP (type) && ! NILP (newval) |
902 |
&& XTYPE (newval) != XINT (type)) |
&& XTYPE (newval) != XINT (type)) |
903 |
buffer_slot_type_mismatch (offset); |
buffer_slot_type_mismatch (offset); |
940 |
Lisp_Object symbol; |
Lisp_Object symbol; |
941 |
{ |
{ |
942 |
Lisp_Object valcontents, cdr; |
Lisp_Object valcontents, cdr; |
943 |
|
|
944 |
valcontents = SYMBOL_VALUE (symbol); |
valcontents = SYMBOL_VALUE (symbol); |
945 |
if (!BUFFER_LOCAL_VALUEP (valcontents) |
if (!BUFFER_LOCAL_VALUEP (valcontents) |
946 |
&& !SOME_BUFFER_LOCAL_VALUEP (valcontents)) |
&& !SOME_BUFFER_LOCAL_VALUEP (valcontents)) |
950 |
/* Unload the previously loaded binding. */ |
/* Unload the previously loaded binding. */ |
951 |
Fsetcdr (XCAR (cdr), |
Fsetcdr (XCAR (cdr), |
952 |
do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); |
do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); |
953 |
|
|
954 |
/* Select the global binding in the symbol. */ |
/* Select the global binding in the symbol. */ |
955 |
XSETCAR (cdr, cdr); |
XSETCAR (cdr, cdr); |
956 |
store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL); |
store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL); |
974 |
Lisp_Object symbol, valcontents; |
Lisp_Object symbol, valcontents; |
975 |
{ |
{ |
976 |
register Lisp_Object tem1; |
register Lisp_Object tem1; |
977 |
|
|
978 |
tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; |
tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; |
979 |
|
|
980 |
if (NILP (tem1) |
if (NILP (tem1) |
984 |
{ |
{ |
985 |
if (XSYMBOL (symbol)->indirect_variable) |
if (XSYMBOL (symbol)->indirect_variable) |
986 |
symbol = indirect_variable (symbol); |
symbol = indirect_variable (symbol); |
987 |
|
|
988 |
/* Unload the previously loaded binding. */ |
/* Unload the previously loaded binding. */ |
989 |
tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); |
tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); |
990 |
Fsetcdr (tem1, |
Fsetcdr (tem1, |
1028 |
{ |
{ |
1029 |
register Lisp_Object valcontents; |
register Lisp_Object valcontents; |
1030 |
register Lisp_Object val; |
register Lisp_Object val; |
1031 |
|
|
1032 |
CHECK_SYMBOL (symbol); |
CHECK_SYMBOL (symbol); |
1033 |
valcontents = SYMBOL_VALUE (symbol); |
valcontents = SYMBOL_VALUE (symbol); |
1034 |
|
|
1141 |
return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); |
return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); |
1142 |
|
|
1143 |
innercontents = valcontents = SYMBOL_VALUE (symbol); |
innercontents = valcontents = SYMBOL_VALUE (symbol); |
1144 |
|
|
1145 |
if (BUFFER_OBJFWDP (valcontents)) |
if (BUFFER_OBJFWDP (valcontents)) |
1146 |
{ |
{ |
1147 |
int offset = XBUFFER_OBJFWD (valcontents)->offset; |
int offset = XBUFFER_OBJFWD (valcontents)->offset; |
1218 |
and load that binding. */ |
and load that binding. */ |
1219 |
else |
else |
1220 |
{ |
{ |
1221 |
tem1 = Fcons (symbol, Fcdr (current_alist_element)); |
tem1 = Fcons (symbol, XCDR (current_alist_element)); |
1222 |
buf->local_var_alist |
buf->local_var_alist |
1223 |
= Fcons (tem1, buf->local_var_alist); |
= Fcons (tem1, buf->local_var_alist); |
1224 |
} |
} |
1364 |
if (idx > 0) |
if (idx > 0) |
1365 |
{ |
{ |
1366 |
struct buffer *b; |
struct buffer *b; |
1367 |
|
|
1368 |
for (b = all_buffers; b; b = b->next) |
for (b = all_buffers; b; b = b->next) |
1369 |
if (!PER_BUFFER_VALUE_P (b, idx)) |
if (!PER_BUFFER_VALUE_P (b, idx)) |
1370 |
PER_BUFFER_VALUE (b, offset) = value; |
PER_BUFFER_VALUE (b, offset) = value; |
1394 |
DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, |
DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, |
1395 |
doc: /* Set the default value of variable VAR to VALUE. |
doc: /* Set the default value of variable VAR to VALUE. |
1396 |
VAR, the variable name, is literal (not evaluated); |
VAR, the variable name, is literal (not evaluated); |
1397 |
VALUE is an expression and it is evaluated. |
VALUE is an expression: it is evaluated and its value returned. |
1398 |
The default value of a variable is seen in buffers |
The default value of a variable is seen in buffers |
1399 |
that do not have their own values for the variable. |
that do not have their own values for the variable. |
1400 |
|
|
1420 |
do |
do |
1421 |
{ |
{ |
1422 |
val = Feval (Fcar (Fcdr (args_left))); |
val = Feval (Fcar (Fcdr (args_left))); |
1423 |
symbol = Fcar (args_left); |
symbol = XCAR (args_left); |
1424 |
Fset_default (symbol, val); |
Fset_default (symbol, val); |
1425 |
args_left = Fcdr (Fcdr (args_left)); |
args_left = Fcdr (XCDR (args_left)); |
1426 |
} |
} |
1427 |
while (!NILP (args_left)); |
while (!NILP (args_left)); |
1428 |
|
|
1440 |
in which case the default value is in effect. |
in which case the default value is in effect. |
1441 |
Note that binding the variable with `let', or setting it while |
Note that binding the variable with `let', or setting it while |
1442 |
a `let'-style binding made in this buffer is in effect, |
a `let'-style binding made in this buffer is in effect, |
1443 |
does not make the variable buffer-local. |
does not make the variable buffer-local. Return VARIABLE. |
1444 |
|
|
1445 |
The function `default-value' gets the default value and `set-default' sets it. */) |
The function `default-value' gets the default value and `set-default' sets it. */) |
1446 |
(variable) |
(variable) |
1452 |
|
|
1453 |
valcontents = SYMBOL_VALUE (variable); |
valcontents = SYMBOL_VALUE (variable); |
1454 |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
1455 |
error ("Symbol %s may not be buffer-local", XSTRING (SYMBOL_NAME (variable))->data); |
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); |
1456 |
|
|
1457 |
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) |
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) |
1458 |
return variable; |
return variable; |
1484 |
Other buffers will continue to share a common default value. |
Other buffers will continue to share a common default value. |
1485 |
\(The buffer-local value of VARIABLE starts out as the same value |
\(The buffer-local value of VARIABLE starts out as the same value |
1486 |
VARIABLE previously had. If VARIABLE was void, it remains void.\) |
VARIABLE previously had. If VARIABLE was void, it remains void.\) |
1487 |
See also `make-variable-buffer-local'. |
See also `make-variable-buffer-local'. Return VARIABLE. |
1488 |
|
|
1489 |
If the variable is already arranged to become local when set, |
If the variable is already arranged to become local when set, |
1490 |
this function causes a local value to exist for this buffer, |
this function causes a local value to exist for this buffer, |
1505 |
|
|
1506 |
valcontents = SYMBOL_VALUE (variable); |
valcontents = SYMBOL_VALUE (variable); |
1507 |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
1508 |
error ("Symbol %s may not be buffer-local", XSTRING (SYMBOL_NAME (variable))->data); |
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); |
1509 |
|
|
1510 |
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) |
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) |
1511 |
{ |
{ |
1574 |
DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable, |
DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable, |
1575 |
1, 1, "vKill Local Variable: ", |
1, 1, "vKill Local Variable: ", |
1576 |
doc: /* Make VARIABLE no longer have a separate value in the current buffer. |
doc: /* Make VARIABLE no longer have a separate value in the current buffer. |
1577 |
From now on the default value will apply in this buffer. */) |
From now on the default value will apply in this buffer. Return VARIABLE. */) |
1578 |
(variable) |
(variable) |
1579 |
register Lisp_Object variable; |
register Lisp_Object variable; |
1580 |
{ |
{ |
1613 |
loaded, recompute its value. We have to do it now, or else |
loaded, recompute its value. We have to do it now, or else |
1614 |
forwarded objects won't work right. */ |
forwarded objects won't work right. */ |
1615 |
{ |
{ |
1616 |
Lisp_Object *pvalbuf; |
Lisp_Object *pvalbuf, buf; |
1617 |
valcontents = SYMBOL_VALUE (variable); |
valcontents = SYMBOL_VALUE (variable); |
1618 |
pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; |
pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; |
1619 |
if (current_buffer == XBUFFER (*pvalbuf)) |
XSETBUFFER (buf, current_buffer); |
1620 |
|
if (EQ (buf, *pvalbuf)) |
1621 |
{ |
{ |
1622 |
*pvalbuf = Qnil; |
*pvalbuf = Qnil; |
1623 |
XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; |
XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; |
1635 |
doc: /* Enable VARIABLE to have frame-local bindings. |
doc: /* Enable VARIABLE to have frame-local bindings. |
1636 |
When a frame-local binding exists in the current frame, |
When a frame-local binding exists in the current frame, |
1637 |
it is in effect whenever the current buffer has no buffer-local binding. |
it is in effect whenever the current buffer has no buffer-local binding. |
1638 |
A frame-local binding is actual a frame parameter value; |
A frame-local binding is actually a frame parameter value; |
1639 |
thus, any given frame has a local binding for VARIABLE |
thus, any given frame has a local binding for VARIABLE if it has |
1640 |
if it has a value for the frame parameter named VARIABLE. |
a value for the frame parameter named VARIABLE. Return VARIABLE. |
1641 |
See `modify-frame-parameters'. */) |
See `modify-frame-parameters' for how to set frame parameters. */) |
1642 |
(variable) |
(variable) |
1643 |
register Lisp_Object variable; |
register Lisp_Object variable; |
1644 |
{ |
{ |
1649 |
valcontents = SYMBOL_VALUE (variable); |
valcontents = SYMBOL_VALUE (variable); |
1650 |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) |
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) |
1651 |
|| BUFFER_OBJFWDP (valcontents)) |
|| BUFFER_OBJFWDP (valcontents)) |
1652 |
error ("Symbol %s may not be frame-local", XSTRING (SYMBOL_NAME (variable))->data); |
error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); |
1653 |
|
|
1654 |
if (BUFFER_LOCAL_VALUEP (valcontents) |
if (BUFFER_LOCAL_VALUEP (valcontents) |
1655 |
|| SOME_BUFFER_LOCAL_VALUEP (valcontents)) |
|| SOME_BUFFER_LOCAL_VALUEP (valcontents)) |
1833 |
{ |
{ |
1834 |
int c, idxval_byte; |
int c, idxval_byte; |
1835 |
|
|
1836 |
if (idxval < 0 || idxval >= XSTRING (array)->size) |
if (idxval < 0 || idxval >= SCHARS (array)) |
1837 |
args_out_of_range (array, idx); |
args_out_of_range (array, idx); |
1838 |
if (! STRING_MULTIBYTE (array)) |
if (! STRING_MULTIBYTE (array)) |
1839 |
return make_number ((unsigned char) XSTRING (array)->data[idxval]); |
return make_number ((unsigned char) SREF (array, idxval)); |
1840 |
idxval_byte = string_char_to_byte (array, idxval); |
idxval_byte = string_char_to_byte (array, idxval); |
1841 |
|
|
1842 |
c = STRING_CHAR (&XSTRING (array)->data[idxval_byte], |
c = STRING_CHAR (SDATA (array) + idxval_byte, |
1843 |
STRING_BYTES (XSTRING (array)) - idxval_byte); |
SBYTES (array) - idxval_byte); |
1844 |
return make_number (c); |
return make_number (c); |
1845 |
} |
} |
1846 |
else if (BOOL_VECTOR_P (array)) |
else if (BOOL_VECTOR_P (array)) |
1950 |
|
|
1951 |
DEFUN ("aset", Faset, Saset, 3, 3, 0, |
DEFUN ("aset", Faset, Saset, 3, 3, 0, |
1952 |
doc: /* Store into the element of ARRAY at index IDX the value NEWELT. |
doc: /* Store into the element of ARRAY at index IDX the value NEWELT. |
1953 |
ARRAY may be a vector, a string, a char-table or a bool-vector. |
Return NEWELT. ARRAY may be a vector, a string, a char-table or a |
1954 |
IDX starts at 0. */) |
bool-vector. IDX starts at 0. */) |
1955 |
(array, idx, newelt) |
(array, idx, newelt) |
1956 |
register Lisp_Object array; |
register Lisp_Object array; |
1957 |
Lisp_Object idx, newelt; |
Lisp_Object idx, newelt; |
2032 |
int idxval_byte, prev_bytes, new_bytes; |
int idxval_byte, prev_bytes, new_bytes; |
2033 |
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
2034 |
|
|
2035 |
if (idxval < 0 || idxval >= XSTRING (array)->size) |
if (idxval < 0 || idxval >= SCHARS (array)) |
2036 |
args_out_of_range (array, idx); |
args_out_of_range (array, idx); |
2037 |
CHECK_NUMBER (newelt); |
CHECK_NUMBER (newelt); |
2038 |
|
|
2039 |
idxval_byte = string_char_to_byte (array, idxval); |
idxval_byte = string_char_to_byte (array, idxval); |
2040 |
p1 = &XSTRING (array)->data[idxval_byte]; |
p1 = SDATA (array) + idxval_byte; |
2041 |
PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes); |
PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes); |
2042 |
new_bytes = CHAR_STRING (XINT (newelt), p0); |
new_bytes = CHAR_STRING (XINT (newelt), p0); |
2043 |
if (prev_bytes != new_bytes) |
if (prev_bytes != new_bytes) |
2044 |
{ |
{ |
2045 |
/* We must relocate the string data. */ |
/* We must relocate the string data. */ |
2046 |
int nchars = XSTRING (array)->size; |
int nchars = SCHARS (array); |
2047 |
int nbytes = STRING_BYTES (XSTRING (array)); |
int nbytes = SBYTES (array); |
2048 |
unsigned char *str; |
unsigned char *str; |
2049 |
|
|
2050 |
str = (nbytes <= MAX_ALLOCA |
str = (nbytes <= MAX_ALLOCA |
2051 |
? (unsigned char *) alloca (nbytes) |
? (unsigned char *) alloca (nbytes) |
2052 |
: (unsigned char *) xmalloc (nbytes)); |
: (unsigned char *) xmalloc (nbytes)); |
2053 |
bcopy (XSTRING (array)->data, str, nbytes); |
bcopy (SDATA (array), str, nbytes); |
2054 |
allocate_string_data (XSTRING (array), nchars, |
allocate_string_data (XSTRING (array), nchars, |
2055 |
nbytes + new_bytes - prev_bytes); |
nbytes + new_bytes - prev_bytes); |
2056 |
bcopy (str, XSTRING (array)->data, idxval_byte); |
bcopy (str, SDATA (array), idxval_byte); |
2057 |
p1 = XSTRING (array)->data + idxval_byte; |
p1 = SDATA (array) + idxval_byte; |
2058 |
bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, |
bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, |
2059 |
nbytes - (idxval_byte + prev_bytes)); |
nbytes - (idxval_byte + prev_bytes)); |
2060 |
if (nbytes > MAX_ALLOCA) |
if (nbytes > MAX_ALLOCA) |
2066 |
} |
} |
2067 |
else |
else |
2068 |
{ |
{ |
2069 |
if (idxval < 0 || idxval >= XSTRING (array)->size) |
if (idxval < 0 || idxval >= SCHARS (array)) |
2070 |
args_out_of_range (array, idx); |
args_out_of_range (array, idx); |
2071 |
CHECK_NUMBER (newelt); |
CHECK_NUMBER (newelt); |
2072 |
|
|
2073 |
if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) |
if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) |
2074 |
XSTRING (array)->data[idxval] = XINT (newelt); |
SSET (array, idxval, XINT (newelt)); |
2075 |
else |
else |
2076 |
{ |
{ |
2077 |
/* We must relocate the string data while converting it to |
/* We must relocate the string data while converting it to |
2078 |
multibyte. */ |
multibyte. */ |
2079 |
int idxval_byte, prev_bytes, new_bytes; |
int idxval_byte, prev_bytes, new_bytes; |
2080 |
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
2081 |
unsigned char *origstr = XSTRING (array)->data, *str; |
unsigned char *origstr = SDATA (array), *str; |
2082 |
int nchars, nbytes; |
int nchars, nbytes; |
2083 |
|
|
2084 |
nchars = XSTRING (array)->size; |
nchars = SCHARS (array); |
2085 |
nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); |
nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); |
2086 |
nbytes += count_size_as_multibyte (origstr + idxval, |
nbytes += count_size_as_multibyte (origstr + idxval, |
2087 |
nchars - idxval); |
nchars - idxval); |
2088 |
str = (nbytes <= MAX_ALLOCA |
str = (nbytes <= MAX_ALLOCA |
2089 |
? (unsigned char *) alloca (nbytes) |
? (unsigned char *) alloca (nbytes) |
2090 |
: (unsigned char *) xmalloc (nbytes)); |
: (unsigned char *) xmalloc (nbytes)); |
2091 |
copy_text (XSTRING (array)->data, str, nchars, 0, 1); |
copy_text (SDATA (array), str, nchars, 0, 1); |
2092 |
PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, |
PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, |
2093 |
prev_bytes); |
prev_bytes); |
2094 |
new_bytes = CHAR_STRING (XINT (newelt), p0); |
new_bytes = CHAR_STRING (XINT (newelt), p0); |
2095 |
allocate_string_data (XSTRING (array), nchars, |
allocate_string_data (XSTRING (array), nchars, |
2096 |
nbytes + new_bytes - prev_bytes); |
nbytes + new_bytes - prev_bytes); |
2097 |
bcopy (str, XSTRING (array)->data, idxval_byte); |
bcopy (str, SDATA (array), idxval_byte); |
2098 |
p1 = XSTRING (array)->data + idxval_byte; |
p1 = SDATA (array) + idxval_byte; |
2099 |
while (new_bytes--) |
while (new_bytes--) |
2100 |
*p1++ = *p0++; |
*p1++ = *p0++; |
2101 |
bcopy (str + idxval_byte + prev_bytes, p1, |
bcopy (str + idxval_byte + prev_bytes, p1, |
2243 |
long_to_cons (i) |
long_to_cons (i) |
2244 |
unsigned long i; |
unsigned long i; |
2245 |
{ |
{ |
2246 |
unsigned int top = i >> 16; |
unsigned long top = i >> 16; |
2247 |
unsigned int bot = i & 0xFFFF; |
unsigned int bot = i & 0xFFFF; |
2248 |
if (top == 0) |
if (top == 0) |
2249 |
return make_number (bot); |
return make_number (bot); |
2267 |
} |
} |
2268 |
|
|
2269 |
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, |
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, |
2270 |
doc: /* Convert NUMBER to a string by printing it in decimal. |
doc: /* Return the decimal representation of NUMBER as a string. |
2271 |
Uses a minus sign if negative. |
Uses a minus sign if negative. |
2272 |
NUMBER may be an integer or a floating point number. */) |
NUMBER may be an integer or a floating point number. */) |
2273 |
(number) |
(number) |
2313 |
return -1; |
return -1; |
2314 |
else |
else |
2315 |
return digit; |
return digit; |
2316 |
} |
} |
2317 |
|
|
2318 |
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, |
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, |
2319 |
doc: /* Convert STRING to a number by parsing it as a decimal number. |
doc: /* Parse STRING as a decimal number and return the number. |
2320 |
This parses both integers and floating point numbers. |
This parses both integers and floating point numbers. |
2321 |
It ignores leading spaces and tabs. |
It ignores leading spaces and tabs. |
2322 |
|
|
2345 |
|
|
2346 |
/* Skip any whitespace at the front of the number. Some versions of |
/* Skip any whitespace at the front of the number. Some versions of |
2347 |
atoi do this anyway, so we might as well make Emacs lisp consistent. */ |
atoi do this anyway, so we might as well make Emacs lisp consistent. */ |
2348 |
p = XSTRING (string)->data; |
p = SDATA (string); |
2349 |
while (*p == ' ' || *p == '\t') |
while (*p == ' ' || *p == '\t') |
2350 |
p++; |
p++; |
2351 |
|
|
2356 |
} |
} |
2357 |
else if (*p == '+') |
else if (*p == '+') |
2358 |
p++; |
p++; |
2359 |
|
|
2360 |
if (isfloat_string (p) && b == 10) |
if (isfloat_string (p) && b == 10) |
2361 |
val = make_float (sign * atof (p)); |
val = make_float (sign * atof (p)); |
2362 |
else |
else |
2559 |
} |
} |
2560 |
|
|
2561 |
DEFUN ("-", Fminus, Sminus, 0, MANY, 0, |
DEFUN ("-", Fminus, Sminus, 0, MANY, 0, |
2562 |
doc: /* Negate number or subtract numbers or markers. |
doc: /* Negate number or subtract numbers or markers and return the result. |
2563 |
With one arg, negates it. With more than one arg, |
With one arg, negates it. With more than one arg, |
2564 |
subtracts all but the first from the first. |
subtracts all but the first from the first. |
2565 |
usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) |
usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) |
2745 |
DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, |
DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, |
2746 |
doc: /* Return VALUE with its bits shifted left by COUNT. |
doc: /* Return VALUE with its bits shifted left by COUNT. |
2747 |
If COUNT is negative, shifting is actually to the right. |
If COUNT is negative, shifting is actually to the right. |
2748 |
In this case, zeros are shifted in on the left. */) |
In this case, zeros are shifted in on the left. */) |
2749 |
(value, count) |
(value, count) |
2750 |
register Lisp_Object value, count; |
register Lisp_Object value, count; |
2751 |
{ |
{ |
3212 |
DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum, |
DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum, |
3213 |
doc: /* The largest value that is representable in a Lisp integer. */); |
doc: /* The largest value that is representable in a Lisp integer. */); |
3214 |
Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); |
Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); |
3215 |
|
|
3216 |
DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum, |
DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum, |
3217 |
doc: /* The smallest value that is representable in a Lisp integer. */); |
doc: /* The smallest value that is representable in a Lisp integer. */); |
3218 |
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); |
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); |