Mercurial > emacs
comparison src/data.c @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 7931f73b31db |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. | 1 /* 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 | 2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000, |
3 Free Software Foundation, Inc. | 3 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
4 | 4 |
5 This file is part of GNU Emacs. | 5 This file is part of GNU Emacs. |
6 | 6 |
7 GNU Emacs is free software; you can redistribute it and/or modify | 7 GNU Emacs is free software; you can redistribute it and/or modify |
8 it under the terms of the GNU General Public License as published by | 8 it under the terms of the GNU General Public License as published by |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 GNU General Public License for more details. | 15 GNU General Public License for more details. |
16 | 16 |
17 You should have received a copy of the GNU General Public License | 17 You should have received a copy of the GNU General Public License |
18 along with GNU Emacs; see the file COPYING. If not, write to | 18 along with GNU Emacs; see the file COPYING. If not, write to |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
20 Boston, MA 02111-1307, USA. */ | 20 Boston, MA 02110-1301, USA. */ |
21 | 21 |
22 | 22 |
23 #include <config.h> | 23 #include <config.h> |
24 #include <signal.h> | 24 #include <signal.h> |
25 #include <stdio.h> | 25 #include <stdio.h> |
69 Lisp_Object Qsetting_constant, Qinvalid_read_syntax; | 69 Lisp_Object Qsetting_constant, Qinvalid_read_syntax; |
70 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; | 70 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; |
71 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; | 71 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; |
72 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; | 72 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; |
73 Lisp_Object Qtext_read_only; | 73 Lisp_Object Qtext_read_only; |
74 | |
74 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp; | 75 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp; |
75 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; | 76 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; |
76 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; | 77 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; |
77 Lisp_Object Qbuffer_or_string_p, Qkeywordp; | 78 Lisp_Object Qbuffer_or_string_p, Qkeywordp; |
78 Lisp_Object Qboundp, Qfboundp; | 79 Lisp_Object Qboundp, Qfboundp; |
85 Lisp_Object Qoverflow_error, Qunderflow_error; | 86 Lisp_Object Qoverflow_error, Qunderflow_error; |
86 | 87 |
87 Lisp_Object Qfloatp; | 88 Lisp_Object Qfloatp; |
88 Lisp_Object Qnumberp, Qnumber_or_marker_p; | 89 Lisp_Object Qnumberp, Qnumber_or_marker_p; |
89 | 90 |
90 static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; | 91 Lisp_Object Qinteger; |
92 static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; | |
91 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; | 93 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; |
92 Lisp_Object Qprocess; | 94 Lisp_Object Qprocess; |
93 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; | 95 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; |
94 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; | 96 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; |
95 static Lisp_Object Qsubrp, Qmany, Qunevalled; | 97 static Lisp_Object Qsubrp, Qmany, Qunevalled; |
715 for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string | 717 for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string |
716 determined by DEFINITION. */) | 718 determined by DEFINITION. */) |
717 (symbol, definition, docstring) | 719 (symbol, definition, docstring) |
718 register Lisp_Object symbol, definition, docstring; | 720 register Lisp_Object symbol, definition, docstring; |
719 { | 721 { |
722 CHECK_SYMBOL (symbol); | |
720 if (CONSP (XSYMBOL (symbol)->function) | 723 if (CONSP (XSYMBOL (symbol)->function) |
721 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) | 724 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) |
722 LOADHIST_ATTACH (Fcons (Qt, symbol)); | 725 LOADHIST_ATTACH (Fcons (Qt, symbol)); |
723 definition = Ffset (symbol, definition); | 726 definition = Ffset (symbol, definition); |
724 LOADHIST_ATTACH (symbol); | 727 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); |
725 if (!NILP (docstring)) | 728 if (!NILP (docstring)) |
726 Fput (symbol, Qfunction_documentation, docstring); | 729 Fput (symbol, Qfunction_documentation, docstring); |
727 return definition; | 730 return definition; |
728 } | 731 } |
729 | 732 |
730 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, | 733 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, |
731 doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. */) | 734 doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */) |
732 (symbol, newplist) | 735 (symbol, newplist) |
733 register Lisp_Object symbol, newplist; | 736 register Lisp_Object symbol, newplist; |
734 { | 737 { |
735 CHECK_SYMBOL (symbol); | 738 CHECK_SYMBOL (symbol); |
736 XSYMBOL (symbol)->plist = newplist; | 739 XSYMBOL (symbol)->plist = newplist; |
757 return Fcons (make_number (minargs), Qunevalled); | 760 return Fcons (make_number (minargs), Qunevalled); |
758 else | 761 else |
759 return Fcons (make_number (minargs), make_number (maxargs)); | 762 return Fcons (make_number (minargs), make_number (maxargs)); |
760 } | 763 } |
761 | 764 |
762 DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, | 765 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, |
763 doc: /* Return the interactive form of SUBR or nil if none. | 766 doc: /* Return name of subroutine SUBR. |
764 SUBR must be a built-in function. Value, if non-nil, is a list | 767 SUBR must be a built-in function. */) |
765 \(interactive SPEC). */) | |
766 (subr) | 768 (subr) |
767 Lisp_Object subr; | 769 Lisp_Object subr; |
768 { | 770 { |
771 const char *name; | |
769 if (!SUBRP (subr)) | 772 if (!SUBRP (subr)) |
770 wrong_type_argument (Qsubrp, subr); | 773 wrong_type_argument (Qsubrp, subr); |
771 if (XSUBR (subr)->prompt) | 774 name = XSUBR (subr)->symbol_name; |
772 return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); | 775 return make_string (name, strlen (name)); |
776 } | |
777 | |
778 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, | |
779 doc: /* Return the interactive form of CMD or nil if none. | |
780 If CMD is not a command, the return value is nil. | |
781 Value, if non-nil, is a list \(interactive SPEC). */) | |
782 (cmd) | |
783 Lisp_Object cmd; | |
784 { | |
785 Lisp_Object fun = indirect_function (cmd); | |
786 | |
787 if (SUBRP (fun)) | |
788 { | |
789 if (XSUBR (fun)->prompt) | |
790 return list2 (Qinteractive, build_string (XSUBR (fun)->prompt)); | |
791 } | |
792 else if (COMPILEDP (fun)) | |
793 { | |
794 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) | |
795 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); | |
796 } | |
797 else if (CONSP (fun)) | |
798 { | |
799 Lisp_Object funcar = XCAR (fun); | |
800 if (EQ (funcar, Qlambda)) | |
801 return Fassq (Qinteractive, Fcdr (XCDR (fun))); | |
802 else if (EQ (funcar, Qautoload)) | |
803 { | |
804 struct gcpro gcpro1; | |
805 GCPRO1 (cmd); | |
806 do_autoload (fun, cmd); | |
807 UNGCPRO; | |
808 return Finteractive_form (cmd); | |
809 } | |
810 } | |
773 return Qnil; | 811 return Qnil; |
774 } | 812 } |
775 | 813 |
776 | 814 |
777 /*********************************************************************** | 815 /*********************************************************************** |
888 *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1; | 926 *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1; |
889 break; | 927 break; |
890 | 928 |
891 case Lisp_Misc_Objfwd: | 929 case Lisp_Misc_Objfwd: |
892 *XOBJFWD (valcontents)->objvar = newval; | 930 *XOBJFWD (valcontents)->objvar = newval; |
931 | |
932 /* If this variable is a default for something stored | |
933 in the buffer itself, such as default-fill-column, | |
934 find the buffers that don't have local values for it | |
935 and update them. */ | |
936 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults | |
937 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1)) | |
938 { | |
939 int offset = ((char *) XOBJFWD (valcontents)->objvar | |
940 - (char *) &buffer_defaults); | |
941 int idx = PER_BUFFER_IDX (offset); | |
942 | |
943 Lisp_Object tail; | |
944 | |
945 if (idx <= 0) | |
946 break; | |
947 | |
948 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) | |
949 { | |
950 Lisp_Object buf; | |
951 struct buffer *b; | |
952 | |
953 buf = Fcdr (XCAR (tail)); | |
954 if (!BUFFERP (buf)) continue; | |
955 b = XBUFFER (buf); | |
956 | |
957 if (! PER_BUFFER_VALUE_P (b, idx)) | |
958 PER_BUFFER_VALUE (b, offset) = newval; | |
959 } | |
960 } | |
893 break; | 961 break; |
894 | 962 |
895 case Lisp_Misc_Buffer_Objfwd: | 963 case Lisp_Misc_Buffer_Objfwd: |
896 { | 964 { |
897 int offset = XBUFFER_OBJFWD (valcontents)->offset; | 965 int offset = XBUFFER_OBJFWD (valcontents)->offset; |
898 Lisp_Object type; | 966 Lisp_Object type; |
899 | 967 |
900 type = PER_BUFFER_TYPE (offset); | 968 type = PER_BUFFER_TYPE (offset); |
901 if (XINT (type) == -1) | |
902 error ("Variable %s is read-only", SDATA (SYMBOL_NAME (symbol))); | |
903 | |
904 if (! NILP (type) && ! NILP (newval) | 969 if (! NILP (type) && ! NILP (newval) |
905 && XTYPE (newval) != XINT (type)) | 970 && XTYPE (newval) != XINT (type)) |
906 buffer_slot_type_mismatch (offset); | 971 buffer_slot_type_mismatch (offset); |
907 | 972 |
908 if (buf == NULL) | 973 if (buf == NULL) |
1093 | 1158 |
1094 static int | 1159 static int |
1095 let_shadows_buffer_binding_p (symbol) | 1160 let_shadows_buffer_binding_p (symbol) |
1096 Lisp_Object symbol; | 1161 Lisp_Object symbol; |
1097 { | 1162 { |
1098 struct specbinding *p; | 1163 volatile struct specbinding *p; |
1099 | 1164 |
1100 for (p = specpdl_ptr - 1; p >= specpdl; p--) | 1165 for (p = specpdl_ptr - 1; p >= specpdl; p--) |
1101 if (p->func == NULL | 1166 if (p->func == NULL |
1102 && CONSP (p->symbol)) | 1167 && CONSP (p->symbol)) |
1103 { | 1168 { |
1339 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); | 1404 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); |
1340 return value; | 1405 return value; |
1341 } | 1406 } |
1342 | 1407 |
1343 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, | 1408 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, |
1344 doc: /* Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated. | 1409 doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. |
1345 The default value is seen in buffers that do not have their own values | 1410 The default value is seen in buffers that do not have their own values |
1346 for this variable. */) | 1411 for this variable. */) |
1347 (symbol, value) | 1412 (symbol, value) |
1348 Lisp_Object symbol, value; | 1413 Lisp_Object symbol, value; |
1349 { | 1414 { |
1392 value, NULL); | 1457 value, NULL); |
1393 | 1458 |
1394 return value; | 1459 return value; |
1395 } | 1460 } |
1396 | 1461 |
1397 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, | 1462 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0, |
1398 doc: /* Set the default value of variable VAR to VALUE. | 1463 doc: /* Set the default value of variable VAR to VALUE. |
1399 VAR, the variable name, is literal (not evaluated); | 1464 VAR, the variable name, is literal (not evaluated); |
1400 VALUE is an expression: it is evaluated and its value returned. | 1465 VALUE is an expression: it is evaluated and its value returned. |
1401 The default value of a variable is seen in buffers | 1466 The default value of a variable is seen in buffers |
1402 that do not have their own values for the variable. | 1467 that do not have their own values for the variable. |
1403 | 1468 |
1404 More generally, you can use multiple variables and values, as in | 1469 More generally, you can use multiple variables and values, as in |
1405 (setq-default SYMBOL VALUE SYMBOL VALUE...) | 1470 (setq-default VAR VALUE VAR VALUE...) |
1406 This sets each SYMBOL's default value to the corresponding VALUE. | 1471 This sets each VAR's default value to the corresponding VALUE. |
1407 The VALUE for the Nth SYMBOL can refer to the new default values | 1472 The VALUE for the Nth VAR can refer to the new default values |
1408 of previous SYMs. | 1473 of previous VARs. |
1409 usage: (setq-default SYMBOL VALUE [SYMBOL VALUE...]) */) | 1474 usage: (setq-default [VAR VALUE...]) */) |
1410 (args) | 1475 (args) |
1411 Lisp_Object args; | 1476 Lisp_Object args; |
1412 { | 1477 { |
1413 register Lisp_Object args_left; | 1478 register Lisp_Object args_left; |
1414 register Lisp_Object val, symbol; | 1479 register Lisp_Object val, symbol; |
1443 in which case the default value is in effect. | 1508 in which case the default value is in effect. |
1444 Note that binding the variable with `let', or setting it while | 1509 Note that binding the variable with `let', or setting it while |
1445 a `let'-style binding made in this buffer is in effect, | 1510 a `let'-style binding made in this buffer is in effect, |
1446 does not make the variable buffer-local. Return VARIABLE. | 1511 does not make the variable buffer-local. Return VARIABLE. |
1447 | 1512 |
1513 In most cases it is better to use `make-local-variable', | |
1514 which makes a variable local in just one buffer. | |
1515 | |
1448 The function `default-value' gets the default value and `set-default' sets it. */) | 1516 The function `default-value' gets the default value and `set-default' sets it. */) |
1449 (variable) | 1517 (variable) |
1450 register Lisp_Object variable; | 1518 register Lisp_Object variable; |
1451 { | 1519 { |
1452 register Lisp_Object tem, valcontents, newval; | 1520 register Lisp_Object tem, valcontents, newval; |
1453 | 1521 |
1454 CHECK_SYMBOL (variable); | 1522 CHECK_SYMBOL (variable); |
1523 variable = indirect_variable (variable); | |
1455 | 1524 |
1456 valcontents = SYMBOL_VALUE (variable); | 1525 valcontents = SYMBOL_VALUE (variable); |
1457 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) | 1526 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
1458 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); | 1527 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); |
1459 | 1528 |
1485 1, 1, "vMake Local Variable: ", | 1554 1, 1, "vMake Local Variable: ", |
1486 doc: /* Make VARIABLE have a separate value in the current buffer. | 1555 doc: /* Make VARIABLE have a separate value in the current buffer. |
1487 Other buffers will continue to share a common default value. | 1556 Other buffers will continue to share a common default value. |
1488 \(The buffer-local value of VARIABLE starts out as the same value | 1557 \(The buffer-local value of VARIABLE starts out as the same value |
1489 VARIABLE previously had. If VARIABLE was void, it remains void.\) | 1558 VARIABLE previously had. If VARIABLE was void, it remains void.\) |
1490 See also `make-variable-buffer-local'. Return VARIABLE. | 1559 Return VARIABLE. |
1491 | 1560 |
1492 If the variable is already arranged to become local when set, | 1561 If the variable is already arranged to become local when set, |
1493 this function causes a local value to exist for this buffer, | 1562 this function causes a local value to exist for this buffer, |
1494 just as setting the variable would do. | 1563 just as setting the variable would do. |
1495 | 1564 |
1496 This function returns VARIABLE, and therefore | 1565 This function returns VARIABLE, and therefore |
1497 (set (make-local-variable 'VARIABLE) VALUE-EXP) | 1566 (set (make-local-variable 'VARIABLE) VALUE-EXP) |
1498 works. | 1567 works. |
1568 | |
1569 See also `make-variable-buffer-local'. | |
1499 | 1570 |
1500 Do not use `make-local-variable' to make a hook variable buffer-local. | 1571 Do not use `make-local-variable' to make a hook variable buffer-local. |
1501 Instead, use `add-hook' and specify t for the LOCAL argument. */) | 1572 Instead, use `add-hook' and specify t for the LOCAL argument. */) |
1502 (variable) | 1573 (variable) |
1503 register Lisp_Object variable; | 1574 register Lisp_Object variable; |
1504 { | 1575 { |
1505 register Lisp_Object tem, valcontents; | 1576 register Lisp_Object tem, valcontents; |
1506 | 1577 |
1507 CHECK_SYMBOL (variable); | 1578 CHECK_SYMBOL (variable); |
1579 variable = indirect_variable (variable); | |
1508 | 1580 |
1509 valcontents = SYMBOL_VALUE (variable); | 1581 valcontents = SYMBOL_VALUE (variable); |
1510 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) | 1582 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) |
1511 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); | 1583 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); |
1512 | 1584 |
1582 register Lisp_Object variable; | 1654 register Lisp_Object variable; |
1583 { | 1655 { |
1584 register Lisp_Object tem, valcontents; | 1656 register Lisp_Object tem, valcontents; |
1585 | 1657 |
1586 CHECK_SYMBOL (variable); | 1658 CHECK_SYMBOL (variable); |
1659 variable = indirect_variable (variable); | |
1587 | 1660 |
1588 valcontents = SYMBOL_VALUE (variable); | 1661 valcontents = SYMBOL_VALUE (variable); |
1589 | 1662 |
1590 if (BUFFER_OBJFWDP (valcontents)) | 1663 if (BUFFER_OBJFWDP (valcontents)) |
1591 { | 1664 { |
1614 | 1687 |
1615 /* If the symbol is set up with the current buffer's binding | 1688 /* If the symbol is set up with the current buffer's binding |
1616 loaded, recompute its value. We have to do it now, or else | 1689 loaded, recompute its value. We have to do it now, or else |
1617 forwarded objects won't work right. */ | 1690 forwarded objects won't work right. */ |
1618 { | 1691 { |
1619 Lisp_Object *pvalbuf; | 1692 Lisp_Object *pvalbuf, buf; |
1620 valcontents = SYMBOL_VALUE (variable); | 1693 valcontents = SYMBOL_VALUE (variable); |
1621 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; | 1694 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; |
1622 if (current_buffer == XBUFFER (*pvalbuf)) | 1695 XSETBUFFER (buf, current_buffer); |
1696 if (EQ (buf, *pvalbuf)) | |
1623 { | 1697 { |
1624 *pvalbuf = Qnil; | 1698 *pvalbuf = Qnil; |
1625 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; | 1699 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; |
1626 find_symbol_value (variable); | 1700 find_symbol_value (variable); |
1627 } | 1701 } |
1633 /* Lisp functions for creating and removing buffer-local variables. */ | 1707 /* Lisp functions for creating and removing buffer-local variables. */ |
1634 | 1708 |
1635 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local, | 1709 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local, |
1636 1, 1, "vMake Variable Frame Local: ", | 1710 1, 1, "vMake Variable Frame Local: ", |
1637 doc: /* Enable VARIABLE to have frame-local bindings. | 1711 doc: /* Enable VARIABLE to have frame-local bindings. |
1638 When a frame-local binding exists in the current frame, | 1712 This does not create any frame-local bindings for VARIABLE, |
1639 it is in effect whenever the current buffer has no buffer-local binding. | 1713 it just makes them possible. |
1640 A frame-local binding is actually a frame parameter value; | 1714 |
1641 thus, any given frame has a local binding for VARIABLE if it has | 1715 A frame-local binding is actually a frame parameter value. |
1642 a value for the frame parameter named VARIABLE. Return VARIABLE. | 1716 If a frame F has a value for the frame parameter named VARIABLE, |
1643 See `modify-frame-parameters' for how to set frame parameters. */) | 1717 that also acts as a frame-local binding for VARIABLE in F-- |
1718 provided this function has been called to enable VARIABLE | |
1719 to have frame-local bindings at all. | |
1720 | |
1721 The only way to create a frame-local binding for VARIABLE in a frame | |
1722 is to set the VARIABLE frame parameter of that frame. See | |
1723 `modify-frame-parameters' for how to set frame parameters. | |
1724 | |
1725 Buffer-local bindings take precedence over frame-local bindings. */) | |
1644 (variable) | 1726 (variable) |
1645 register Lisp_Object variable; | 1727 register Lisp_Object variable; |
1646 { | 1728 { |
1647 register Lisp_Object tem, valcontents, newval; | 1729 register Lisp_Object tem, valcontents, newval; |
1648 | 1730 |
1649 CHECK_SYMBOL (variable); | 1731 CHECK_SYMBOL (variable); |
1732 variable = indirect_variable (variable); | |
1650 | 1733 |
1651 valcontents = SYMBOL_VALUE (variable); | 1734 valcontents = SYMBOL_VALUE (variable); |
1652 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) | 1735 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) |
1653 || BUFFER_OBJFWDP (valcontents)) | 1736 || BUFFER_OBJFWDP (valcontents)) |
1654 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); | 1737 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); |
1694 CHECK_BUFFER (buffer); | 1777 CHECK_BUFFER (buffer); |
1695 buf = XBUFFER (buffer); | 1778 buf = XBUFFER (buffer); |
1696 } | 1779 } |
1697 | 1780 |
1698 CHECK_SYMBOL (variable); | 1781 CHECK_SYMBOL (variable); |
1782 variable = indirect_variable (variable); | |
1699 | 1783 |
1700 valcontents = SYMBOL_VALUE (variable); | 1784 valcontents = SYMBOL_VALUE (variable); |
1701 if (BUFFER_LOCAL_VALUEP (valcontents) | 1785 if (BUFFER_LOCAL_VALUEP (valcontents) |
1702 || SOME_BUFFER_LOCAL_VALUEP (valcontents)) | 1786 || SOME_BUFFER_LOCAL_VALUEP (valcontents)) |
1703 { | 1787 { |
1704 Lisp_Object tail, elt; | 1788 Lisp_Object tail, elt; |
1705 | 1789 |
1706 variable = indirect_variable (variable); | |
1707 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) | 1790 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) |
1708 { | 1791 { |
1709 elt = XCAR (tail); | 1792 elt = XCAR (tail); |
1710 if (EQ (variable, XCAR (elt))) | 1793 if (EQ (variable, XCAR (elt))) |
1711 return Qt; | 1794 return Qt; |
1721 return Qnil; | 1804 return Qnil; |
1722 } | 1805 } |
1723 | 1806 |
1724 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, | 1807 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, |
1725 1, 2, 0, | 1808 1, 2, 0, |
1726 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. | 1809 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there. |
1810 More precisely, this means that setting the variable \(with `set' or`setq'), | |
1811 while it does not have a `let'-style binding that was made in BUFFER, | |
1812 will produce a buffer local binding. See Info node | |
1813 `(elisp)Creating Buffer-Local'. | |
1727 BUFFER defaults to the current buffer. */) | 1814 BUFFER defaults to the current buffer. */) |
1728 (variable, buffer) | 1815 (variable, buffer) |
1729 register Lisp_Object variable, buffer; | 1816 register Lisp_Object variable, buffer; |
1730 { | 1817 { |
1731 Lisp_Object valcontents; | 1818 Lisp_Object valcontents; |
1738 CHECK_BUFFER (buffer); | 1825 CHECK_BUFFER (buffer); |
1739 buf = XBUFFER (buffer); | 1826 buf = XBUFFER (buffer); |
1740 } | 1827 } |
1741 | 1828 |
1742 CHECK_SYMBOL (variable); | 1829 CHECK_SYMBOL (variable); |
1830 variable = indirect_variable (variable); | |
1743 | 1831 |
1744 valcontents = SYMBOL_VALUE (variable); | 1832 valcontents = SYMBOL_VALUE (variable); |
1745 | 1833 |
1746 /* This means that make-variable-buffer-local was done. */ | 1834 /* This means that make-variable-buffer-local was done. */ |
1747 if (BUFFER_LOCAL_VALUEP (valcontents)) | 1835 if (BUFFER_LOCAL_VALUEP (valcontents)) |
1757 elt = XCAR (tail); | 1845 elt = XCAR (tail); |
1758 if (EQ (variable, XCAR (elt))) | 1846 if (EQ (variable, XCAR (elt))) |
1759 return Qt; | 1847 return Qt; |
1760 } | 1848 } |
1761 } | 1849 } |
1850 return Qnil; | |
1851 } | |
1852 | |
1853 DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus, | |
1854 1, 1, 0, | |
1855 doc: /* Return a value indicating where VARIABLE's current binding comes from. | |
1856 If the current binding is buffer-local, the value is the current buffer. | |
1857 If the current binding is frame-local, the value is the selected frame. | |
1858 If the current binding is global (the default), the value is nil. */) | |
1859 (variable) | |
1860 register Lisp_Object variable; | |
1861 { | |
1862 Lisp_Object valcontents; | |
1863 | |
1864 CHECK_SYMBOL (variable); | |
1865 variable = indirect_variable (variable); | |
1866 | |
1867 /* Make sure the current binding is actually swapped in. */ | |
1868 find_symbol_value (variable); | |
1869 | |
1870 valcontents = XSYMBOL (variable)->value; | |
1871 | |
1872 if (BUFFER_LOCAL_VALUEP (valcontents) | |
1873 || SOME_BUFFER_LOCAL_VALUEP (valcontents) | |
1874 || BUFFER_OBJFWDP (valcontents)) | |
1875 { | |
1876 /* For a local variable, record both the symbol and which | |
1877 buffer's or frame's value we are saving. */ | |
1878 if (!NILP (Flocal_variable_p (variable, Qnil))) | |
1879 return Fcurrent_buffer (); | |
1880 else if (!BUFFER_OBJFWDP (valcontents) | |
1881 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) | |
1882 return XBUFFER_LOCAL_VALUE (valcontents)->frame; | |
1883 } | |
1884 | |
1762 return Qnil; | 1885 return Qnil; |
1763 } | 1886 } |
1764 | 1887 |
1765 /* Find the function at the end of a chain of symbol function indirections. */ | 1888 /* Find the function at the end of a chain of symbol function indirections. */ |
1766 | 1889 |
1850 int val; | 1973 int val; |
1851 | 1974 |
1852 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) | 1975 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) |
1853 args_out_of_range (array, idx); | 1976 args_out_of_range (array, idx); |
1854 | 1977 |
1855 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; | 1978 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; |
1856 return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil); | 1979 return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil); |
1857 } | 1980 } |
1858 else if (CHAR_TABLE_P (array)) | 1981 else if (CHAR_TABLE_P (array)) |
1859 { | 1982 { |
1860 Lisp_Object val; | 1983 Lisp_Object val; |
1861 | 1984 |
1863 | 1986 |
1864 if (idxval < 0) | 1987 if (idxval < 0) |
1865 args_out_of_range (array, idx); | 1988 args_out_of_range (array, idx); |
1866 if (idxval < CHAR_TABLE_ORDINARY_SLOTS) | 1989 if (idxval < CHAR_TABLE_ORDINARY_SLOTS) |
1867 { | 1990 { |
1991 if (! SINGLE_BYTE_CHAR_P (idxval)) | |
1992 args_out_of_range (array, idx); | |
1868 /* For ASCII and 8-bit European characters, the element is | 1993 /* For ASCII and 8-bit European characters, the element is |
1869 stored in the top table. */ | 1994 stored in the top table. */ |
1870 val = XCHAR_TABLE (array)->contents[idxval]; | 1995 val = XCHAR_TABLE (array)->contents[idxval]; |
1996 if (NILP (val)) | |
1997 { | |
1998 int default_slot | |
1999 = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII | |
2000 : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL | |
2001 : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); | |
2002 val = XCHAR_TABLE (array)->contents[default_slot]; | |
2003 } | |
1871 if (NILP (val)) | 2004 if (NILP (val)) |
1872 val = XCHAR_TABLE (array)->defalt; | 2005 val = XCHAR_TABLE (array)->defalt; |
1873 while (NILP (val)) /* Follow parents until we find some value. */ | 2006 while (NILP (val)) /* Follow parents until we find some value. */ |
1874 { | 2007 { |
1875 array = XCHAR_TABLE (array)->parent; | 2008 array = XCHAR_TABLE (array)->parent; |
1883 } | 2016 } |
1884 else | 2017 else |
1885 { | 2018 { |
1886 int code[4], i; | 2019 int code[4], i; |
1887 Lisp_Object sub_table; | 2020 Lisp_Object sub_table; |
2021 Lisp_Object current_default; | |
1888 | 2022 |
1889 SPLIT_CHAR (idxval, code[0], code[1], code[2]); | 2023 SPLIT_CHAR (idxval, code[0], code[1], code[2]); |
1890 if (code[1] < 32) code[1] = -1; | 2024 if (code[1] < 32) code[1] = -1; |
1891 else if (code[2] < 32) code[2] = -1; | 2025 else if (code[2] < 32) code[2] = -1; |
1892 | 2026 |
1896 increment CODE[0] by 128 to get a correct index. */ | 2030 increment CODE[0] by 128 to get a correct index. */ |
1897 code[0] += 128; | 2031 code[0] += 128; |
1898 code[3] = -1; /* anchor */ | 2032 code[3] = -1; /* anchor */ |
1899 | 2033 |
1900 try_parent_char_table: | 2034 try_parent_char_table: |
2035 current_default = XCHAR_TABLE (array)->defalt; | |
1901 sub_table = array; | 2036 sub_table = array; |
1902 for (i = 0; code[i] >= 0; i++) | 2037 for (i = 0; code[i] >= 0; i++) |
1903 { | 2038 { |
1904 val = XCHAR_TABLE (sub_table)->contents[code[i]]; | 2039 val = XCHAR_TABLE (sub_table)->contents[code[i]]; |
1905 if (SUB_CHAR_TABLE_P (val)) | 2040 if (SUB_CHAR_TABLE_P (val)) |
1906 sub_table = val; | 2041 { |
2042 sub_table = val; | |
2043 if (! NILP (XCHAR_TABLE (sub_table)->defalt)) | |
2044 current_default = XCHAR_TABLE (sub_table)->defalt; | |
2045 } | |
1907 else | 2046 else |
1908 { | 2047 { |
1909 if (NILP (val)) | 2048 if (NILP (val)) |
1910 val = XCHAR_TABLE (sub_table)->defalt; | 2049 val = current_default; |
1911 if (NILP (val)) | 2050 if (NILP (val)) |
1912 { | 2051 { |
1913 array = XCHAR_TABLE (array)->parent; | 2052 array = XCHAR_TABLE (array)->parent; |
1914 if (!NILP (array)) | 2053 if (!NILP (array)) |
1915 goto try_parent_char_table; | 2054 goto try_parent_char_table; |
1916 } | 2055 } |
1917 return val; | 2056 return val; |
1918 } | 2057 } |
1919 } | 2058 } |
1920 /* Here, VAL is a sub char table. We try the default value | 2059 /* Reaching here means IDXVAL is a generic character in |
1921 and parent. */ | 2060 which each character or a group has independent value. |
1922 val = XCHAR_TABLE (val)->defalt; | 2061 Essentially it's nonsense to get a value for such a |
2062 generic character, but for backward compatibility, we try | |
2063 the default value and parent. */ | |
2064 val = current_default; | |
1923 if (NILP (val)) | 2065 if (NILP (val)) |
1924 { | 2066 { |
1925 array = XCHAR_TABLE (array)->parent; | 2067 array = XCHAR_TABLE (array)->parent; |
1926 if (!NILP (array)) | 2068 if (!NILP (array)) |
1927 goto try_parent_char_table; | 2069 goto try_parent_char_table; |
1943 args_out_of_range (array, idx); | 2085 args_out_of_range (array, idx); |
1944 return XVECTOR (array)->contents[idxval]; | 2086 return XVECTOR (array)->contents[idxval]; |
1945 } | 2087 } |
1946 } | 2088 } |
1947 | 2089 |
1948 /* Don't use alloca for relocating string data larger than this, lest | |
1949 we overflow their stack. The value is the same as what used in | |
1950 fns.c for base64 handling. */ | |
1951 #define MAX_ALLOCA 16*1024 | |
1952 | |
1953 DEFUN ("aset", Faset, Saset, 3, 3, 0, | 2090 DEFUN ("aset", Faset, Saset, 3, 3, 0, |
1954 doc: /* Store into the element of ARRAY at index IDX the value NEWELT. | 2091 doc: /* Store into the element of ARRAY at index IDX the value NEWELT. |
1955 Return NEWELT. ARRAY may be a vector, a string, a char-table or a | 2092 Return NEWELT. ARRAY may be a vector, a string, a char-table or a |
1956 bool-vector. IDX starts at 0. */) | 2093 bool-vector. IDX starts at 0. */) |
1957 (array, idx, newelt) | 2094 (array, idx, newelt) |
1978 int val; | 2115 int val; |
1979 | 2116 |
1980 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) | 2117 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) |
1981 args_out_of_range (array, idx); | 2118 args_out_of_range (array, idx); |
1982 | 2119 |
1983 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; | 2120 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; |
1984 | 2121 |
1985 if (! NILP (newelt)) | 2122 if (! NILP (newelt)) |
1986 val |= 1 << (idxval % BITS_PER_CHAR); | 2123 val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR); |
1987 else | 2124 else |
1988 val &= ~(1 << (idxval % BITS_PER_CHAR)); | 2125 val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)); |
1989 XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val; | 2126 XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val; |
1990 } | 2127 } |
1991 else if (CHAR_TABLE_P (array)) | 2128 else if (CHAR_TABLE_P (array)) |
1992 { | 2129 { |
1993 if (idxval < 0) | 2130 if (idxval < 0) |
1994 args_out_of_range (array, idx); | 2131 args_out_of_range (array, idx); |
1995 if (idxval < CHAR_TABLE_ORDINARY_SLOTS) | 2132 if (idxval < CHAR_TABLE_ORDINARY_SLOTS) |
1996 XCHAR_TABLE (array)->contents[idxval] = newelt; | 2133 { |
2134 if (! SINGLE_BYTE_CHAR_P (idxval)) | |
2135 args_out_of_range (array, idx); | |
2136 XCHAR_TABLE (array)->contents[idxval] = newelt; | |
2137 } | |
1997 else | 2138 else |
1998 { | 2139 { |
1999 int code[4], i; | 2140 int code[4], i; |
2000 Lisp_Object val; | 2141 Lisp_Object val; |
2001 | 2142 |
2014 else | 2155 else |
2015 { | 2156 { |
2016 Lisp_Object temp; | 2157 Lisp_Object temp; |
2017 | 2158 |
2018 /* VAL is a leaf. Create a sub char table with the | 2159 /* VAL is a leaf. Create a sub char table with the |
2019 default value VAL or XCHAR_TABLE (array)->defalt | 2160 initial value VAL and look into it. */ |
2020 and look into it. */ | 2161 |
2021 | 2162 temp = make_sub_char_table (val); |
2022 temp = make_sub_char_table (NILP (val) | |
2023 ? XCHAR_TABLE (array)->defalt | |
2024 : val); | |
2025 XCHAR_TABLE (array)->contents[code[i]] = temp; | 2163 XCHAR_TABLE (array)->contents[code[i]] = temp; |
2026 array = temp; | 2164 array = temp; |
2027 } | 2165 } |
2028 } | 2166 } |
2029 XCHAR_TABLE (array)->contents[code[i]] = newelt; | 2167 XCHAR_TABLE (array)->contents[code[i]] = newelt; |
2030 } | 2168 } |
2031 } | 2169 } |
2032 else if (STRING_MULTIBYTE (array)) | 2170 else if (STRING_MULTIBYTE (array)) |
2033 { | 2171 { |
2034 int idxval_byte, prev_bytes, new_bytes; | 2172 int idxval_byte, prev_bytes, new_bytes, nbytes; |
2035 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; | 2173 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
2036 | 2174 |
2037 if (idxval < 0 || idxval >= SCHARS (array)) | 2175 if (idxval < 0 || idxval >= SCHARS (array)) |
2038 args_out_of_range (array, idx); | 2176 args_out_of_range (array, idx); |
2039 CHECK_NUMBER (newelt); | 2177 CHECK_NUMBER (newelt); |
2178 | |
2179 nbytes = SBYTES (array); | |
2040 | 2180 |
2041 idxval_byte = string_char_to_byte (array, idxval); | 2181 idxval_byte = string_char_to_byte (array, idxval); |
2042 p1 = SDATA (array) + idxval_byte; | 2182 p1 = SDATA (array) + idxval_byte; |
2043 PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes); | 2183 PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes); |
2044 new_bytes = CHAR_STRING (XINT (newelt), p0); | 2184 new_bytes = CHAR_STRING (XINT (newelt), p0); |
2045 if (prev_bytes != new_bytes) | 2185 if (prev_bytes != new_bytes) |
2046 { | 2186 { |
2047 /* We must relocate the string data. */ | 2187 /* We must relocate the string data. */ |
2048 int nchars = SCHARS (array); | 2188 int nchars = SCHARS (array); |
2049 int nbytes = SBYTES (array); | |
2050 unsigned char *str; | 2189 unsigned char *str; |
2051 | 2190 USE_SAFE_ALLOCA; |
2052 str = (nbytes <= MAX_ALLOCA | 2191 |
2053 ? (unsigned char *) alloca (nbytes) | 2192 SAFE_ALLOCA (str, unsigned char *, nbytes); |
2054 : (unsigned char *) xmalloc (nbytes)); | |
2055 bcopy (SDATA (array), str, nbytes); | 2193 bcopy (SDATA (array), str, nbytes); |
2056 allocate_string_data (XSTRING (array), nchars, | 2194 allocate_string_data (XSTRING (array), nchars, |
2057 nbytes + new_bytes - prev_bytes); | 2195 nbytes + new_bytes - prev_bytes); |
2058 bcopy (str, SDATA (array), idxval_byte); | 2196 bcopy (str, SDATA (array), idxval_byte); |
2059 p1 = SDATA (array) + idxval_byte; | 2197 p1 = SDATA (array) + idxval_byte; |
2060 bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, | 2198 bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes, |
2061 nbytes - (idxval_byte + prev_bytes)); | 2199 nbytes - (idxval_byte + prev_bytes)); |
2062 if (nbytes > MAX_ALLOCA) | 2200 SAFE_FREE (); |
2063 xfree (str); | |
2064 clear_string_char_byte_cache (); | 2201 clear_string_char_byte_cache (); |
2065 } | 2202 } |
2066 while (new_bytes--) | 2203 while (new_bytes--) |
2067 *p1++ = *p0++; | 2204 *p1++ = *p0++; |
2068 } | 2205 } |
2080 multibyte. */ | 2217 multibyte. */ |
2081 int idxval_byte, prev_bytes, new_bytes; | 2218 int idxval_byte, prev_bytes, new_bytes; |
2082 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; | 2219 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; |
2083 unsigned char *origstr = SDATA (array), *str; | 2220 unsigned char *origstr = SDATA (array), *str; |
2084 int nchars, nbytes; | 2221 int nchars, nbytes; |
2222 USE_SAFE_ALLOCA; | |
2085 | 2223 |
2086 nchars = SCHARS (array); | 2224 nchars = SCHARS (array); |
2087 nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); | 2225 nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); |
2088 nbytes += count_size_as_multibyte (origstr + idxval, | 2226 nbytes += count_size_as_multibyte (origstr + idxval, |
2089 nchars - idxval); | 2227 nchars - idxval); |
2090 str = (nbytes <= MAX_ALLOCA | 2228 SAFE_ALLOCA (str, unsigned char *, nbytes); |
2091 ? (unsigned char *) alloca (nbytes) | |
2092 : (unsigned char *) xmalloc (nbytes)); | |
2093 copy_text (SDATA (array), str, nchars, 0, 1); | 2229 copy_text (SDATA (array), str, nchars, 0, 1); |
2094 PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, | 2230 PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, |
2095 prev_bytes); | 2231 prev_bytes); |
2096 new_bytes = CHAR_STRING (XINT (newelt), p0); | 2232 new_bytes = CHAR_STRING (XINT (newelt), p0); |
2097 allocate_string_data (XSTRING (array), nchars, | 2233 allocate_string_data (XSTRING (array), nchars, |
2100 p1 = SDATA (array) + idxval_byte; | 2236 p1 = SDATA (array) + idxval_byte; |
2101 while (new_bytes--) | 2237 while (new_bytes--) |
2102 *p1++ = *p0++; | 2238 *p1++ = *p0++; |
2103 bcopy (str + idxval_byte + prev_bytes, p1, | 2239 bcopy (str + idxval_byte + prev_bytes, p1, |
2104 nbytes - (idxval_byte + prev_bytes)); | 2240 nbytes - (idxval_byte + prev_bytes)); |
2105 if (nbytes > MAX_ALLOCA) | 2241 SAFE_FREE (); |
2106 xfree (str); | |
2107 clear_string_char_byte_cache (); | 2242 clear_string_char_byte_cache (); |
2108 } | 2243 } |
2109 } | 2244 } |
2110 | 2245 |
2111 return newelt; | 2246 return newelt; |
2243 | 2378 |
2244 Lisp_Object | 2379 Lisp_Object |
2245 long_to_cons (i) | 2380 long_to_cons (i) |
2246 unsigned long i; | 2381 unsigned long i; |
2247 { | 2382 { |
2248 unsigned int top = i >> 16; | 2383 unsigned long top = i >> 16; |
2249 unsigned int bot = i & 0xFFFF; | 2384 unsigned int bot = i & 0xFFFF; |
2250 if (top == 0) | 2385 if (top == 0) |
2251 return make_number (bot); | 2386 return make_number (bot); |
2252 if (top == (unsigned long)-1 >> 16) | 2387 if (top == (unsigned long)-1 >> 16) |
2253 return Fcons (make_number (-1), make_number (bot)); | 2388 return Fcons (make_number (-1), make_number (bot)); |
2588 usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) | 2723 usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) |
2589 (nargs, args) | 2724 (nargs, args) |
2590 int nargs; | 2725 int nargs; |
2591 Lisp_Object *args; | 2726 Lisp_Object *args; |
2592 { | 2727 { |
2728 int argnum; | |
2729 for (argnum = 2; argnum < nargs; argnum++) | |
2730 if (FLOATP (args[argnum])) | |
2731 return float_arith_driver (0, 0, Adiv, nargs, args); | |
2593 return arith_driver (Adiv, nargs, args); | 2732 return arith_driver (Adiv, nargs, args); |
2594 } | 2733 } |
2595 | 2734 |
2596 DEFUN ("%", Frem, Srem, 2, 2, 0, | 2735 DEFUN ("%", Frem, Srem, 2, 2, 0, |
2597 doc: /* Return remainder of X divided by Y. | 2736 doc: /* Return remainder of X divided by Y. |
2804 { | 2943 { |
2805 CHECK_NUMBER (number); | 2944 CHECK_NUMBER (number); |
2806 XSETINT (number, ~XINT (number)); | 2945 XSETINT (number, ~XINT (number)); |
2807 return number; | 2946 return number; |
2808 } | 2947 } |
2948 | |
2949 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, | |
2950 doc: /* Return the byteorder for the machine. | |
2951 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII | |
2952 lowercase l) for small endian machines. */) | |
2953 () | |
2954 { | |
2955 unsigned i = 0x04030201; | |
2956 int order = *(char *)&i == 1 ? 108 : 66; | |
2957 | |
2958 return make_number (order); | |
2959 } | |
2960 | |
2961 | |
2809 | 2962 |
2810 void | 2963 void |
2811 syms_of_data () | 2964 syms_of_data () |
2812 { | 2965 { |
2813 Lisp_Object error_tail, arith_tail; | 2966 Lisp_Object error_tail, arith_tail; |
3035 staticpro (&Qquit); | 3188 staticpro (&Qquit); |
3036 staticpro (&Qwrong_type_argument); | 3189 staticpro (&Qwrong_type_argument); |
3037 staticpro (&Qargs_out_of_range); | 3190 staticpro (&Qargs_out_of_range); |
3038 staticpro (&Qvoid_function); | 3191 staticpro (&Qvoid_function); |
3039 staticpro (&Qcyclic_function_indirection); | 3192 staticpro (&Qcyclic_function_indirection); |
3193 staticpro (&Qcyclic_variable_indirection); | |
3040 staticpro (&Qvoid_variable); | 3194 staticpro (&Qvoid_variable); |
3041 staticpro (&Qsetting_constant); | 3195 staticpro (&Qsetting_constant); |
3042 staticpro (&Qinvalid_read_syntax); | 3196 staticpro (&Qinvalid_read_syntax); |
3043 staticpro (&Qwrong_number_of_arguments); | 3197 staticpro (&Qwrong_number_of_arguments); |
3044 staticpro (&Qinvalid_function); | 3198 staticpro (&Qinvalid_function); |
3120 staticpro (&Qchar_table); | 3274 staticpro (&Qchar_table); |
3121 staticpro (&Qbool_vector); | 3275 staticpro (&Qbool_vector); |
3122 staticpro (&Qhash_table); | 3276 staticpro (&Qhash_table); |
3123 | 3277 |
3124 defsubr (&Sindirect_variable); | 3278 defsubr (&Sindirect_variable); |
3125 defsubr (&Ssubr_interactive_form); | 3279 defsubr (&Sinteractive_form); |
3126 defsubr (&Seq); | 3280 defsubr (&Seq); |
3127 defsubr (&Snull); | 3281 defsubr (&Snull); |
3128 defsubr (&Stype_of); | 3282 defsubr (&Stype_of); |
3129 defsubr (&Slistp); | 3283 defsubr (&Slistp); |
3130 defsubr (&Snlistp); | 3284 defsubr (&Snlistp); |
3178 defsubr (&Smake_local_variable); | 3332 defsubr (&Smake_local_variable); |
3179 defsubr (&Skill_local_variable); | 3333 defsubr (&Skill_local_variable); |
3180 defsubr (&Smake_variable_frame_local); | 3334 defsubr (&Smake_variable_frame_local); |
3181 defsubr (&Slocal_variable_p); | 3335 defsubr (&Slocal_variable_p); |
3182 defsubr (&Slocal_variable_if_set_p); | 3336 defsubr (&Slocal_variable_if_set_p); |
3337 defsubr (&Svariable_binding_locus); | |
3183 defsubr (&Saref); | 3338 defsubr (&Saref); |
3184 defsubr (&Saset); | 3339 defsubr (&Saset); |
3185 defsubr (&Snumber_to_string); | 3340 defsubr (&Snumber_to_string); |
3186 defsubr (&Sstring_to_number); | 3341 defsubr (&Sstring_to_number); |
3187 defsubr (&Seqlsign); | 3342 defsubr (&Seqlsign); |
3205 defsubr (&Slsh); | 3360 defsubr (&Slsh); |
3206 defsubr (&Sash); | 3361 defsubr (&Sash); |
3207 defsubr (&Sadd1); | 3362 defsubr (&Sadd1); |
3208 defsubr (&Ssub1); | 3363 defsubr (&Ssub1); |
3209 defsubr (&Slognot); | 3364 defsubr (&Slognot); |
3365 defsubr (&Sbyteorder); | |
3210 defsubr (&Ssubr_arity); | 3366 defsubr (&Ssubr_arity); |
3367 defsubr (&Ssubr_name); | |
3211 | 3368 |
3212 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; | 3369 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; |
3213 | 3370 |
3214 DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum, | 3371 DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum, |
3215 doc: /* The largest value that is representable in a Lisp integer. */); | 3372 doc: /* The largest value that is representable in a Lisp integer. */); |
3237 sigrelse (SIGFPE); | 3394 sigrelse (SIGFPE); |
3238 #else /* not BSD4_1 */ | 3395 #else /* not BSD4_1 */ |
3239 sigsetmask (SIGEMPTYMASK); | 3396 sigsetmask (SIGEMPTYMASK); |
3240 #endif /* not BSD4_1 */ | 3397 #endif /* not BSD4_1 */ |
3241 | 3398 |
3399 SIGNAL_THREAD_CHECK (signo); | |
3242 Fsignal (Qarith_error, Qnil); | 3400 Fsignal (Qarith_error, Qnil); |
3243 } | 3401 } |
3244 | 3402 |
3245 void | 3403 void |
3246 init_data () | 3404 init_data () |
3257 | 3415 |
3258 #ifdef uts | 3416 #ifdef uts |
3259 signal (SIGEMT, arith_error); | 3417 signal (SIGEMT, arith_error); |
3260 #endif /* uts */ | 3418 #endif /* uts */ |
3261 } | 3419 } |
3420 | |
3421 /* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7 | |
3422 (do not change this comment) */ |