aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c143
1 files changed, 129 insertions, 14 deletions
diff --git a/src/data.c b/src/data.c
index 0e2a704f529..92e1c75dee4 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
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, 2003 2 Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 03, 2004
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -71,6 +71,7 @@ Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
71Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; 71Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
72Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; 72Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
73Lisp_Object Qtext_read_only; 73Lisp_Object Qtext_read_only;
74
74Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp; 75Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
75Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; 76Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
76Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; 77Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
@@ -87,7 +88,8 @@ Lisp_Object Qoverflow_error, Qunderflow_error;
87Lisp_Object Qfloatp; 88Lisp_Object Qfloatp;
88Lisp_Object Qnumberp, Qnumber_or_marker_p; 89Lisp_Object Qnumberp, Qnumber_or_marker_p;
89 90
90static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; 91Lisp_Object Qinteger;
92static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
91static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; 93static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
92Lisp_Object Qprocess; 94Lisp_Object Qprocess;
93static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; 95static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
@@ -728,7 +730,7 @@ determined by DEFINITION. */)
728} 730}
729 731
730DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, 732DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
731 doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. */) 733 doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */)
732 (symbol, newplist) 734 (symbol, newplist)
733 register Lisp_Object symbol, newplist; 735 register Lisp_Object symbol, newplist;
734{ 736{
@@ -759,17 +761,39 @@ function with `&rest' args, or `unevalled' for a special form. */)
759 return Fcons (make_number (minargs), make_number (maxargs)); 761 return Fcons (make_number (minargs), make_number (maxargs));
760} 762}
761 763
762DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, 764DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
763 doc: /* Return the interactive form of SUBR or nil if none. 765 doc: /* Return the interactive form of CMD or nil if none.
764SUBR must be a built-in function. Value, if non-nil, is a list 766CMD must be a command. Value, if non-nil, is a list
765\(interactive SPEC). */) 767\(interactive SPEC). */)
766 (subr) 768 (cmd)
767 Lisp_Object subr; 769 Lisp_Object cmd;
768{ 770{
769 if (!SUBRP (subr)) 771 Lisp_Object fun = indirect_function (cmd);
770 wrong_type_argument (Qsubrp, subr); 772
771 if (XSUBR (subr)->prompt) 773 if (SUBRP (fun))
772 return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); 774 {
775 if (XSUBR (fun)->prompt)
776 return list2 (Qinteractive, build_string (XSUBR (fun)->prompt));
777 }
778 else if (COMPILEDP (fun))
779 {
780 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
781 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
782 }
783 else if (CONSP (fun))
784 {
785 Lisp_Object funcar = XCAR (fun);
786 if (EQ (funcar, Qlambda))
787 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
788 else if (EQ (funcar, Qautoload))
789 {
790 struct gcpro gcpro1;
791 GCPRO1 (cmd);
792 do_autoload (fun, cmd);
793 UNGCPRO;
794 return Finteractive_form (cmd);
795 }
796 }
773 return Qnil; 797 return Qnil;
774} 798}
775 799
@@ -871,6 +895,8 @@ store_symval_forwarding (symbol, valcontents, newval, buf)
871 register Lisp_Object valcontents, newval; 895 register Lisp_Object valcontents, newval;
872 struct buffer *buf; 896 struct buffer *buf;
873{ 897{
898 int offset;
899
874 switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) 900 switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
875 { 901 {
876 case Lisp_Misc: 902 case Lisp_Misc:
@@ -890,6 +916,36 @@ store_symval_forwarding (symbol, valcontents, newval, buf)
890 916
891 case Lisp_Misc_Objfwd: 917 case Lisp_Misc_Objfwd:
892 *XOBJFWD (valcontents)->objvar = newval; 918 *XOBJFWD (valcontents)->objvar = newval;
919
920 /* If this variable is a default for something stored
921 in the buffer itself, such as default-fill-column,
922 find the buffers that don't have local values for it
923 and update them. */
924 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
925 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
926 {
927 int offset = ((char *) XOBJFWD (valcontents)->objvar
928 - (char *) &buffer_defaults);
929 int idx = PER_BUFFER_IDX (offset);
930
931 Lisp_Object tail, buf;
932
933 if (idx <= 0)
934 break;
935
936 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
937 {
938 Lisp_Object buf;
939 struct buffer *b;
940
941 buf = Fcdr (XCAR (tail));
942 if (!BUFFERP (buf)) continue;
943 b = XBUFFER (buf);
944
945 if (! PER_BUFFER_VALUE_P (b, idx))
946 PER_BUFFER_VALUE (b, offset) = newval;
947 }
948 }
893 break; 949 break;
894 950
895 case Lisp_Misc_Buffer_Objfwd: 951 case Lisp_Misc_Buffer_Objfwd:
@@ -1449,6 +1505,7 @@ The function `default-value' gets the default value and `set-default' sets it.
1449 register Lisp_Object tem, valcontents, newval; 1505 register Lisp_Object tem, valcontents, newval;
1450 1506
1451 CHECK_SYMBOL (variable); 1507 CHECK_SYMBOL (variable);
1508 variable = indirect_variable (variable);
1452 1509
1453 valcontents = SYMBOL_VALUE (variable); 1510 valcontents = SYMBOL_VALUE (variable);
1454 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) 1511 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
@@ -1502,6 +1559,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1502 register Lisp_Object tem, valcontents; 1559 register Lisp_Object tem, valcontents;
1503 1560
1504 CHECK_SYMBOL (variable); 1561 CHECK_SYMBOL (variable);
1562 variable = indirect_variable (variable);
1505 1563
1506 valcontents = SYMBOL_VALUE (variable); 1564 valcontents = SYMBOL_VALUE (variable);
1507 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) 1565 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
@@ -1581,6 +1639,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1581 register Lisp_Object tem, valcontents; 1639 register Lisp_Object tem, valcontents;
1582 1640
1583 CHECK_SYMBOL (variable); 1641 CHECK_SYMBOL (variable);
1642 variable = indirect_variable (variable);
1584 1643
1585 valcontents = SYMBOL_VALUE (variable); 1644 valcontents = SYMBOL_VALUE (variable);
1586 1645
@@ -1645,6 +1704,7 @@ See `modify-frame-parameters' for how to set frame parameters. */)
1645 register Lisp_Object tem, valcontents, newval; 1704 register Lisp_Object tem, valcontents, newval;
1646 1705
1647 CHECK_SYMBOL (variable); 1706 CHECK_SYMBOL (variable);
1707 variable = indirect_variable (variable);
1648 1708
1649 valcontents = SYMBOL_VALUE (variable); 1709 valcontents = SYMBOL_VALUE (variable);
1650 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) 1710 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
@@ -1694,6 +1754,7 @@ BUFFER defaults to the current buffer. */)
1694 } 1754 }
1695 1755
1696 CHECK_SYMBOL (variable); 1756 CHECK_SYMBOL (variable);
1757 variable = indirect_variable (variable);
1697 1758
1698 valcontents = SYMBOL_VALUE (variable); 1759 valcontents = SYMBOL_VALUE (variable);
1699 if (BUFFER_LOCAL_VALUEP (valcontents) 1760 if (BUFFER_LOCAL_VALUEP (valcontents)
@@ -1701,7 +1762,6 @@ BUFFER defaults to the current buffer. */)
1701 { 1762 {
1702 Lisp_Object tail, elt; 1763 Lisp_Object tail, elt;
1703 1764
1704 variable = indirect_variable (variable);
1705 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) 1765 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1706 { 1766 {
1707 elt = XCAR (tail); 1767 elt = XCAR (tail);
@@ -1738,6 +1798,7 @@ BUFFER defaults to the current buffer. */)
1738 } 1798 }
1739 1799
1740 CHECK_SYMBOL (variable); 1800 CHECK_SYMBOL (variable);
1801 variable = indirect_variable (variable);
1741 1802
1742 valcontents = SYMBOL_VALUE (variable); 1803 valcontents = SYMBOL_VALUE (variable);
1743 1804
@@ -1759,6 +1820,41 @@ BUFFER defaults to the current buffer. */)
1759 } 1820 }
1760 return Qnil; 1821 return Qnil;
1761} 1822}
1823
1824DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus,
1825 1, 1, 0,
1826 doc: /* Return a value indicating where VARIABLE's current binding comes from.
1827If the current binding is buffer-local, the value is the current buffer.
1828If the current binding is frame-local, the value is the selected frame.
1829If the current binding is global (the default), the value is nil. */)
1830 (variable)
1831 register Lisp_Object variable;
1832{
1833 Lisp_Object valcontents;
1834
1835 CHECK_SYMBOL (variable);
1836 variable = indirect_variable (variable);
1837
1838 /* Make sure the current binding is actually swapped in. */
1839 find_symbol_value (variable);
1840
1841 valcontents = XSYMBOL (variable)->value;
1842
1843 if (BUFFER_LOCAL_VALUEP (valcontents)
1844 || SOME_BUFFER_LOCAL_VALUEP (valcontents)
1845 || BUFFER_OBJFWDP (valcontents))
1846 {
1847 /* For a local variable, record both the symbol and which
1848 buffer's or frame's value we are saving. */
1849 if (!NILP (Flocal_variable_p (variable, Qnil)))
1850 return Fcurrent_buffer ();
1851 else if (!BUFFER_OBJFWDP (valcontents)
1852 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
1853 return XBUFFER_LOCAL_VALUE (valcontents)->frame;
1854 }
1855
1856 return Qnil;
1857}
1762 1858
1763/* Find the function at the end of a chain of symbol function indirections. */ 1859/* Find the function at the end of a chain of symbol function indirections. */
1764 1860
@@ -2701,6 +2797,20 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
2701 XSETINT (number, ~XINT (number)); 2797 XSETINT (number, ~XINT (number));
2702 return number; 2798 return number;
2703} 2799}
2800
2801DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
2802 doc: /* Return the byteorder for the machine.
2803Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
2804lowercase l) for small endian machines. */)
2805 ()
2806{
2807 unsigned i = 0x04030201;
2808 int order = *(char *)&i == 1 ? 108 : 66;
2809
2810 return make_number (order);
2811}
2812
2813
2704 2814
2705void 2815void
2706syms_of_data () 2816syms_of_data ()
@@ -3017,7 +3127,7 @@ syms_of_data ()
3017 staticpro (&Qhash_table); 3127 staticpro (&Qhash_table);
3018 3128
3019 defsubr (&Sindirect_variable); 3129 defsubr (&Sindirect_variable);
3020 defsubr (&Ssubr_interactive_form); 3130 defsubr (&Sinteractive_form);
3021 defsubr (&Seq); 3131 defsubr (&Seq);
3022 defsubr (&Snull); 3132 defsubr (&Snull);
3023 defsubr (&Stype_of); 3133 defsubr (&Stype_of);
@@ -3075,6 +3185,7 @@ syms_of_data ()
3075 defsubr (&Smake_variable_frame_local); 3185 defsubr (&Smake_variable_frame_local);
3076 defsubr (&Slocal_variable_p); 3186 defsubr (&Slocal_variable_p);
3077 defsubr (&Slocal_variable_if_set_p); 3187 defsubr (&Slocal_variable_if_set_p);
3188 defsubr (&Svariable_binding_locus);
3078 defsubr (&Saref); 3189 defsubr (&Saref);
3079 defsubr (&Saset); 3190 defsubr (&Saset);
3080 defsubr (&Snumber_to_string); 3191 defsubr (&Snumber_to_string);
@@ -3102,6 +3213,7 @@ syms_of_data ()
3102 defsubr (&Sadd1); 3213 defsubr (&Sadd1);
3103 defsubr (&Ssub1); 3214 defsubr (&Ssub1);
3104 defsubr (&Slognot); 3215 defsubr (&Slognot);
3216 defsubr (&Sbyteorder);
3105 defsubr (&Ssubr_arity); 3217 defsubr (&Ssubr_arity);
3106 3218
3107 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; 3219 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
@@ -3154,3 +3266,6 @@ init_data ()
3154 signal (SIGEMT, arith_error); 3266 signal (SIGEMT, arith_error);
3155#endif /* uts */ 3267#endif /* uts */
3156} 3268}
3269
3270/* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7
3271 (do not change this comment) */