annotate src/data.c @ 14122:353ec8b5ede5

(x-cut-buffer-or-selection-value): Don't print messages about failure to get selection or cut buffer.
author Karl Heuer <kwzh@gnu.org>
date Tue, 09 Jan 1996 23:20:39 +0000
parents f3766d691555
children ee40177f6c68
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
2 Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
12244
ac7375e60931 Update GPL to version 2.
Karl Heuer <kwzh@gnu.org>
parents: 12225
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21 #include <signal.h>
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4508
diff changeset
23 #include <config.h>
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 #include "lisp.h"
336
25114d2b73e3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 298
diff changeset
25 #include "puresize.h"
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27 #ifndef standalone
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #include "buffer.h"
11341
e0f3fa4e7bf3 Include keyboard.h.
Richard M. Stallman <rms@gnu.org>
parents: 11239
diff changeset
29 #include "keyboard.h"
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 #endif
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31
552
7013d0e0e476 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 514
diff changeset
32 #include "syssignal.h"
348
17ca8766781a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 336
diff changeset
33
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 #ifdef LISP_FLOAT_TYPE
4860
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
35
2781
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2647
diff changeset
36 #ifdef STDC_HEADERS
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2647
diff changeset
37 #include <stdlib.h>
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2647
diff changeset
38 #endif
4860
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
39
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
40 /* Work around a problem that happens because math.h on hpux 7
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
41 defines two static variables--which, in Emacs, are not really static,
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
42 because `static' is defined as nothing. The problem is that they are
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
43 here, in floatfns.c, and in lread.c.
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
44 These macros prevent the name conflict. */
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
45 #if defined (HPUX) && !defined (HPUX8)
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
46 #define _MAXLDBL data_c_maxldbl
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
47 #define _NMAXLDBL data_c_nmaxldbl
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
48 #endif
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
49
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 #include <math.h>
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52
4780
64cdff1c8ad1 Add declaration for atof if not predefined.
Brian Fox <bfox@gnu.org>
parents: 4696
diff changeset
53 #if !defined (atof)
64cdff1c8ad1 Add declaration for atof if not predefined.
Brian Fox <bfox@gnu.org>
parents: 4696
diff changeset
54 extern double atof ();
64cdff1c8ad1 Add declaration for atof if not predefined.
Brian Fox <bfox@gnu.org>
parents: 4696
diff changeset
55 #endif /* !atof */
64cdff1c8ad1 Add declaration for atof if not predefined.
Brian Fox <bfox@gnu.org>
parents: 4696
diff changeset
56
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
60 Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
4036
fbbd3e138284 Define Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 3675
diff changeset
63 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
65 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
1293
95ae0805ebba Qbuffer_or_string_p added.
Joseph Arceneaux <jla@gnu.org>
parents: 1278
diff changeset
68 Lisp_Object Qbuffer_or_string_p;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 Lisp_Object Qboundp, Qfboundp;
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
70 Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
71
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 Lisp_Object Qcdr;
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
73 Lisp_Object Qad_advice_info, Qad_activate;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
75 Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
76 Lisp_Object Qoverflow_error, Qunderflow_error;
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
77
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78 #ifdef LISP_FLOAT_TYPE
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
79 Lisp_Object Qfloatp;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 Lisp_Object Qnumberp, Qnumber_or_marker_p;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 #endif
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
83 static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
84 static Lisp_Object Qfloat, Qwindow_configuration, Qprocess, Qwindow;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
85 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
86 static Lisp_Object Qchar_table, Qbool_vector;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
87
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 static Lisp_Object swap_in_symval_forwarding ();
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 wrong_type_argument (predicate, value)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 register Lisp_Object predicate, value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 register Lisp_Object tem;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 do
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 if (!EQ (Vmocklisp_arguments, Qt))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
99 if (STRINGP (value) &&
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
101 return Fstring_to_number (value);
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
102 if (INTEGERP (value) && EQ (predicate, Qstringp))
2429
96b55f2f19cd Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents: 2092
diff changeset
103 return Fnumber_to_string (value);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 }
10245
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
105
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
106 /* If VALUE is not even a valid Lisp object, abort here
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
107 where we can get a backtrace showing where it came from. */
10248
8b95a9a6d466 (wrong_type_argument): Use Lisp_Type_Limit.
Richard M. Stallman <rms@gnu.org>
parents: 10245
diff changeset
108 if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
10245
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
109 abort ();
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
110
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 tem = call1 (predicate, value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 }
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
114 while (NILP (tem));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 pure_write_error ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 error ("Attempt to modify read-only object");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 args_out_of_range (a1, a2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 Lisp_Object a1, a2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 args_out_of_range_3 (a1, a2, a3)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 Lisp_Object a1, a2, a3;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 make_number (num)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 int num;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143 register Lisp_Object val;
9263
cda13734e32c (make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
parents: 9194
diff changeset
144 XSETINT (val, num);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 /* On some machines, XINT needs a temporary location.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 Here it is, in case it is needed. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 int sign_extend_temp;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 /* On a few machines, XINT can only be done by calling this. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155 int
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 sign_extend_lisp_int (num)
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
157 EMACS_INT num;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 {
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
159 if (num & (((EMACS_INT) 1) << (VALBITS - 1)))
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
160 return num | (((EMACS_INT) (-1)) << VALBITS);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 else
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
162 return num & ((((EMACS_INT) 1) << VALBITS) - 1);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 /* Data type predicates */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 DEFUN ("eq", Feq, Seq, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 "T if the two args are the same Lisp object.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 (obj1, obj2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 Lisp_Object obj1, obj2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 if (EQ (obj1, obj2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 DEFUN ("null", Fnull, Snull, 1, 1, 0, "T if OBJECT is nil.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
178 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
179 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
181 if (NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
186 DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
187 "Return a symbol representing the type of OBJECT.\n\
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
188 The symbol returned names the object's basic type;\n\
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
189 for example, (type-of 1) returns `integer'.")
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
190 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
191 Lisp_Object object;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
192 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
193 switch (XGCTYPE (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
194 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
195 case Lisp_Int:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
196 return Qinteger;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
197
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
198 case Lisp_Symbol:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
199 return Qsymbol;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
200
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
201 case Lisp_String:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
202 return Qstring;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
203
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
204 case Lisp_Cons:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
205 return Qcons;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
206
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
207 case Lisp_Misc:
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
208 switch (XMISCTYPE (object))
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
209 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
210 case Lisp_Misc_Marker:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
211 return Qmarker;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
212 case Lisp_Misc_Overlay:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
213 return Qoverlay;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
214 case Lisp_Misc_Float:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
215 return Qfloat;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
216 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
217 abort ();
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
218
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
219 case Lisp_Vectorlike:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
220 if (GC_WINDOW_CONFIGURATIONP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
221 return Qwindow_configuration;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
222 if (GC_PROCESSP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
223 return Qprocess;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
224 if (GC_WINDOWP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
225 return Qwindow;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
226 if (GC_SUBRP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
227 return Qsubr;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
228 if (GC_COMPILEDP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
229 return Qcompiled_function;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
230 if (GC_BUFFERP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
231 return Qbuffer;
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
232 if (GC_CHAR_TABLE_P (object))
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
233 return Qchar_table;
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
234 if (GC_BOOL_VECTOR_P (object))
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
235 return Qbool_vector;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
236
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
237 #ifdef MULTI_FRAME
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
238 if (GC_FRAMEP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
239 return Qframe;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
240 #endif
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
241 return Qvector;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
242
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
243 #ifdef LISP_FLOAT_TYPE
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
244 case Lisp_Float:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
245 return Qfloat;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
246 #endif
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
247
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
248 default:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
249 abort ();
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
250 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
251 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
252
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
254 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
255 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
256 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
257 if (CONSP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
258 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
259 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
260 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
261
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
262 DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
263 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
264 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
265 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
266 if (CONSP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
268 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
269 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list. This includes nil.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
272 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
273 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
274 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
275 if (CONSP (object) || NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
276 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
281 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
282 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
284 if (CONSP (object) || NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
290 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
291 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
293 if (SYMBOLP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
299 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
300 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
302 if (VECTORP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
308 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
309 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
311 if (STRINGP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
316 DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a char-table.")
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
317 (object)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
318 Lisp_Object object;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
319 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
320 if (CHAR_TABLE_P (object))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
321 return Qt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
322 return Qnil;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
323 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
324
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
325 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
326 Svector_or_char_table_p, 1, 1, 0,
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
327 "T if OBJECT is a char-table or vector.")
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
328 (object)
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
329 Lisp_Object object;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
330 {
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
331 if (VECTORP (object) || CHAR_TABLE_P (object))
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
332 return Qt;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
333 return Qnil;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
334 }
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
335
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
336 DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "T if OBJECT is a bool-vector.")
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
337 (object)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
338 Lisp_Object object;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
339 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
340 if (BOOL_VECTOR_P (object))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
341 return Qt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
342 return Qnil;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
343 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
344
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
345 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
346 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
347 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
349 if (VECTORP (object) || STRINGP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
353
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 "T if OBJECT is a sequence (list or array).")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
356 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
357 register Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 {
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
359 if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
360 || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
366 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
367 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
369 if (BUFFERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
375 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
376 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
378 if (MARKERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
384 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
385 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
387 if (SUBRP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
392 DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
393 1, 1, 0, "T if OBJECT is a byte-compiled function object.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
394 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
395 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
397 if (COMPILEDP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401
6385
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
402 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
403 "T if OBJECT is a character (an integer) or a string.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
404 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
405 register Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
407 if (INTEGERP (object) || STRINGP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411
6385
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
412 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is an integer.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
413 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
414 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
416 if (INTEGERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
421 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
422 "T if OBJECT is an integer or a marker (editor pointer).")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
423 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
424 register Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
425 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
426 if (MARKERP (object) || INTEGERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
427 return Qt;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
428 return Qnil;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
429 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
430
6385
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
431 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
432 "T if OBJECT is a nonnegative integer.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
433 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
434 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
436 if (NATNUMP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
441 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
442 "T if OBJECT is a number (floating point or integer).")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
443 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
444 Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
445 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
446 if (NUMBERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
447 return Qt;
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
448 else
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
449 return Qnil;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
450 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
451
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
452 DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
453 Snumber_or_marker_p, 1, 1, 0,
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
454 "T if OBJECT is a number or a marker.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
455 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
456 Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
457 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
458 if (NUMBERP (object) || MARKERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
459 return Qt;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
460 return Qnil;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
461 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
462
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 "T if OBJECT is a floating point number.")
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
466 (object)
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
467 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
469 if (FLOATP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 /* Extract and set components of lists */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 DEFUN ("car", Fcar, Scar, 1, 1, 0,
11219
e9702b711640 Doc fixes to match declared args.
Simon Marshall <simon@gnu.org>
parents: 11155
diff changeset
478 "Return the car of LIST. If arg is nil, return nil.\n\
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 Error if arg is not nil and not a cons cell. See also `car-safe'.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 (list)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 register Lisp_Object list;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
485 if (CONSP (list))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 return XCONS (list)->car;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 else if (EQ (list, Qnil))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 list = wrong_type_argument (Qlistp, list);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 "Return the car of OBJECT if it is a cons cell, or else nil.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 (object)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 Lisp_Object object;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
499 if (CONSP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
500 return XCONS (object)->car;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
11219
e9702b711640 Doc fixes to match declared args.
Simon Marshall <simon@gnu.org>
parents: 11155
diff changeset
506 "Return the cdr of LIST. If arg is nil, return nil.\n\
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 (list)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 register Lisp_Object list;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
514 if (CONSP (list))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 return XCONS (list)->cdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 else if (EQ (list, Qnil))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 list = wrong_type_argument (Qlistp, list);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
8798
e10362de8eba (Fcdr_safe): Delete extraneous blank in docstring.
Karl Heuer <kwzh@gnu.org>
parents: 8448
diff changeset
524 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 (object)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 Lisp_Object object;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
528 if (CONSP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 return XCONS (object)->cdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
11219
e9702b711640 Doc fixes to match declared args.
Simon Marshall <simon@gnu.org>
parents: 11155
diff changeset
535 "Set the car of CELL to be NEWCAR. Returns NEWCAR.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536 (cell, newcar)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 register Lisp_Object cell, newcar;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
539 if (!CONSP (cell))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 cell = wrong_type_argument (Qconsp, cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
541
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542 CHECK_IMPURE (cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 XCONS (cell)->car = newcar;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 return newcar;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
11219
e9702b711640 Doc fixes to match declared args.
Simon Marshall <simon@gnu.org>
parents: 11155
diff changeset
548 "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 (cell, newcdr)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 register Lisp_Object cell, newcdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
552 if (!CONSP (cell))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 cell = wrong_type_argument (Qconsp, cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 CHECK_IMPURE (cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556 XCONS (cell)->cdr = newcdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 return newcdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 /* Extract and set components of symbols */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
563 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
564 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 Lisp_Object valcontents;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
567 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
568
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
569 valcontents = XSYMBOL (symbol)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570
9889
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
571 if (BUFFER_LOCAL_VALUEP (valcontents)
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
572 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
573 valcontents = swap_in_symval_forwarding (symbol, valcontents);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
575 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "T if SYMBOL's function definition is not void.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
579 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
580 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
582 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
583 return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
587 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
588 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
590 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
591 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
592 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
593 Fset (symbol, Qunbound);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
594 return symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
598 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
599 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
601 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
602 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
603 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
604 XSYMBOL (symbol)->function = Qunbound;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
605 return symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
608 DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609 "Return SYMBOL's function definition. Error if that is void.")
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
610 (symbol)
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
611 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
612 {
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
613 CHECK_SYMBOL (symbol, 0);
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
614 if (EQ (XSYMBOL (symbol)->function, Qunbound))
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
615 return Fsignal (Qvoid_function, Fcons (symbol, Qnil));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
616 return XSYMBOL (symbol)->function;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
617 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
620 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
621 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
622 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
623 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
624 return XSYMBOL (symbol)->plist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
625 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
626
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
627 DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
628 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
629 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
631 register Lisp_Object name;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
632
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
633 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
634 XSETSTRING (name, XSYMBOL (symbol)->name);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 return name;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
637
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
638 DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
639 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
640 (symbol, newdef)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
641 register Lisp_Object symbol, newdef;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
642 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
643 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
644 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
645 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
646 if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
647 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 Vautoload_queue);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
649 XSYMBOL (symbol)->function = newdef;
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
650 /* Handle automatic advice activation */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
651 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
652 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
653 call2 (Qad_activate, symbol, Qnil);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
654 newdef = XSYMBOL (symbol)->function;
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
655 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 return newdef;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
658
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
659 /* This name should be removed once it is eliminated from elsewhere. */
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
660
2565
c1a1557bffde (Fdefine_function): Changed name back to Fdefalias, so we get things
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2548
diff changeset
661 DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
662 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
663 Associates the function with the current load file, if any.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
664 (symbol, newdef)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
665 register Lisp_Object symbol, newdef;
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
666 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
667 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
668 if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
669 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
670 Vautoload_queue);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
671 XSYMBOL (symbol)->function = newdef;
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
672 /* Handle automatic advice activation */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
673 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
674 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
675 call2 (Qad_activate, symbol, Qnil);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
676 newdef = XSYMBOL (symbol)->function;
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
677 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
678 LOADHIST_ATTACH (symbol);
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
679 return newdef;
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
680 }
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
681
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
682 DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0,
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
683 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
684 Associates the function with the current load file, if any.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
685 (symbol, newdef)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
686 register Lisp_Object symbol, newdef;
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
687 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
688 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
689 if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
690 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
691 Vautoload_queue);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
692 XSYMBOL (symbol)->function = newdef;
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
693 /* Handle automatic advice activation */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
694 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
695 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
696 call2 (Qad_activate, symbol, Qnil);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
697 newdef = XSYMBOL (symbol)->function;
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
698 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
699 LOADHIST_ATTACH (symbol);
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
700 return newdef;
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
701 }
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
702
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
705 (symbol, newplist)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
706 register Lisp_Object symbol, newplist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
708 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
709 XSYMBOL (symbol)->plist = newplist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
710 return newplist;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 }
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
712
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 /* Getting and setting values of symbols */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716 /* Given the raw contents of a symbol value cell,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
717 return the Lisp value of the symbol.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 This does not handle buffer-local variables; use
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 swap_in_symval_forwarding for that. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
721 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 do_symval_forwarding (valcontents)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 register Lisp_Object valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
725 register Lisp_Object val;
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
726 int offset;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
727 if (MISCP (valcontents))
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
728 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
729 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
730 case Lisp_Misc_Intfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
731 XSETINT (val, *XINTFWD (valcontents)->intvar);
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
732 return val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
734 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
735 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
736
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
737 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
738 return *XOBJFWD (valcontents)->objvar;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
739
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
740 case Lisp_Misc_Buffer_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
741 offset = XBUFFER_OBJFWD (valcontents)->offset;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
742 return *(Lisp_Object *)(offset + (char *)current_buffer);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
743
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
744 case Lisp_Misc_Kboard_Objfwd:
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
745 offset = XKBOARD_OBJFWD (valcontents)->offset;
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
746 return *(Lisp_Object *)(offset + (char *)current_kboard);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
747 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
748 return valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
749 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
750
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
751 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
752 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
753 buffer-independent contents of the value cell: forwarded just one
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754 step past the buffer-localness. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
755
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
756 void
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
757 store_symval_forwarding (symbol, valcontents, newval)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
758 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
759 register Lisp_Object valcontents, newval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
760 {
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
761 switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
762 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
763 case Lisp_Misc:
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
764 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
765 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
766 case Lisp_Misc_Intfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
767 CHECK_NUMBER (newval, 1);
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
768 *XINTFWD (valcontents)->intvar = XINT (newval);
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
769 if (*XINTFWD (valcontents)->intvar != XINT (newval))
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
770 error ("Value out of range for variable `%s'",
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
771 XSYMBOL (symbol)->name->data);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
772 break;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
773
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
774 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
775 *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
776 break;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
777
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
778 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
779 *XOBJFWD (valcontents)->objvar = newval;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
780 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
781
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
782 case Lisp_Misc_Buffer_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
783 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
784 int offset = XBUFFER_OBJFWD (valcontents)->offset;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
785 Lisp_Object type;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
786
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
787 type = *(Lisp_Object *)(offset + (char *)&buffer_local_types);
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
788 if (! NILP (type) && ! NILP (newval)
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
789 && XTYPE (newval) != XINT (type))
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
790 buffer_slot_type_mismatch (offset);
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
791
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
792 *(Lisp_Object *)(offset + (char *)current_buffer) = newval;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
793 }
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
794 break;
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
795
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
796 case Lisp_Misc_Kboard_Objfwd:
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
797 (*(Lisp_Object *)((char *)current_kboard
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
798 + XKBOARD_OBJFWD (valcontents)->offset))
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
799 = newval;
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
800 break;
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
801
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
802 default:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
803 goto def;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
804 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
805 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
806
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
807 default:
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
808 def:
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
809 valcontents = XSYMBOL (symbol)->value;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
810 if (BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
811 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
812 XBUFFER_LOCAL_VALUE (valcontents)->car = newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
813 else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
814 XSYMBOL (symbol)->value = newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
815 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
816 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
817
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
818 /* Set up the buffer-local symbol SYMBOL for validity in the current
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819 buffer. VALCONTENTS is the contents of its value cell.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
820 Return the value forwarded one step past the buffer-local indicator. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
822 static Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
823 swap_in_symval_forwarding (symbol, valcontents)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
824 Lisp_Object symbol, valcontents;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
825 {
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
826 /* valcontents is a pointer to a struct resembling the cons
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
827 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
828
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
1263
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
830 local_var_alist, that being the element whose car is this
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
831 variable. Or it can be a pointer to the
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
832 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
833 an element in its alist for this variable.
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
834
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
835 If the current buffer is not BUFFER, we store the current
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
836 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
837 appropriate alist element for the buffer now current and set up
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
838 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
839 element, and store into BUFFER.
3790dfbefb30 * data.c (swap_in_symval_forwarding): Formatting tweaked.
Jim Blandy <jimb@redhat.com>
parents: 1253
diff changeset
840
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841 Note that REALVALUE can be a forwarding pointer. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
842
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
843 register Lisp_Object tem1;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
844 tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
845
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
846 if (NILP (tem1) || current_buffer != XBUFFER (tem1))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
847 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
848 tem1 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
849 Fsetcdr (tem1,
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
850 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
851 tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
852 if (NILP (tem1))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
853 tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
854 XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1;
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
855 XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car,
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
856 current_buffer);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
857 store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car,
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
858 Fcdr (tem1));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 }
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
860 return XBUFFER_LOCAL_VALUE (valcontents)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
861 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
862
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
863 /* Find the value of a symbol, returning Qunbound if it's not bound.
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
864 This is helpful for code which just wants to get a variable's value
14036
621a575db6f7 Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 13715
diff changeset
865 if it has one, without signaling an error.
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
866 Note that it must not be possible to quit
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
867 within this function. Great care is required for this. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
868
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
869 Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
870 find_symbol_value (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
871 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
872 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873 register Lisp_Object valcontents, tem1;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
874 register Lisp_Object val;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
875 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
876 valcontents = XSYMBOL (symbol)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
877
9889
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
878 if (BUFFER_LOCAL_VALUEP (valcontents)
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
879 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
880 valcontents = swap_in_symval_forwarding (symbol, valcontents);
9878
8a68b5794c91 (Fboundp, find_symbol_value): Use type test macros instead of checking XTYPE
Karl Heuer <kwzh@gnu.org>
parents: 9465
diff changeset
881
8a68b5794c91 (Fboundp, find_symbol_value): Use type test macros instead of checking XTYPE
Karl Heuer <kwzh@gnu.org>
parents: 9465
diff changeset
882 if (MISCP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
883 {
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
884 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
885 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
886 case Lisp_Misc_Intfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
887 XSETINT (val, *XINTFWD (valcontents)->intvar);
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
888 return val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
889
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
890 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
891 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
892
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
893 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
894 return *XOBJFWD (valcontents)->objvar;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
895
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
896 case Lisp_Misc_Buffer_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
897 return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
898 + (char *)current_buffer);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
899
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
900 case Lisp_Misc_Kboard_Objfwd:
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
901 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
902 + (char *)current_kboard);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
903 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
904 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
905
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
906 return valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
907 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
908
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
909 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
910 "Return SYMBOL's value. Error if that is void.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
911 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
912 Lisp_Object symbol;
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
913 {
6497
89ff61b53cee (store_symval_forwarding, Fsymbol_value): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents: 6459
diff changeset
914 Lisp_Object val;
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
915
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
916 val = find_symbol_value (symbol);
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
917 if (EQ (val, Qunbound))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
918 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
919 else
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
920 return val;
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
921 }
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
922
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 DEFUN ("set", Fset, Sset, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
924 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
925 (symbol, newval)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
926 register Lisp_Object symbol, newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 {
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
928 int voide = EQ (newval, Qunbound);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
929
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
930 register Lisp_Object valcontents, tem1, current_alist_element;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
931
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
932 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
933 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
934 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
935 valcontents = XSYMBOL (symbol)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
936
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
937 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
938 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
939 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
9364
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
940 register int mask = XINT (*((Lisp_Object *)
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
941 (idx + (char *)&buffer_local_flags)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
942 if (mask > 0)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
943 current_buffer->local_var_flags |= mask;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
944 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
945
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
946 else if (BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
947 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
948 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
949 /* valcontents is actually a pointer to a struct resembling a cons,
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
950 with contents something like:
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
951 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
952
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
953 BUFFER is the last buffer for which this symbol's value was
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
954 made up to date.
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
955
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
956 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
957 local_var_alist, that being the element whose car is this
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
958 variable. Or it can be a pointer to the
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
959 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
960 have an element in its alist for this variable (that is, if
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
961 BUFFER sees the default value of this variable).
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
962
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
963 If we want to examine or set the value and BUFFER is current,
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
964 we just examine or set REALVALUE. If BUFFER is not current, we
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
965 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
966 then find the appropriate alist element for the buffer now
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
967 current and set up CURRENT-ALIST-ELEMENT. Then we set
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
968 REALVALUE out of that element, and store into BUFFER.
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
969
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
970 If we are setting the variable and the current buffer does
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
971 not have an alist entry for this variable, an alist entry is
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
972 created.
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
973
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
974 Note that REALVALUE can be a forwarding pointer. Each time
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
975 it is examined or set, forwarding must be done. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
976
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
977 /* What value are we caching right now? */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
978 current_alist_element =
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
979 XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
980
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
981 /* If the current buffer is not the buffer whose binding is
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
982 currently cached, or if it's a Lisp_Buffer_Local_Value and
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
983 we're looking at the default value, the cache is invalid; we
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
984 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
985 if ((current_buffer
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
986 != XBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car))
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
987 || (BUFFER_LOCAL_VALUEP (valcontents)
1508
768d4c10c2bf * data.c (Fset): See if current_alist_element points to itself
Jim Blandy <jimb@redhat.com>
parents: 1293
diff changeset
988 && EQ (XCONS (current_alist_element)->car,
768d4c10c2bf * data.c (Fset): See if current_alist_element points to itself
Jim Blandy <jimb@redhat.com>
parents: 1293
diff changeset
989 current_alist_element)))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
990 {
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
991 /* Write out the cached value for the old buffer; copy it
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
992 back to its alist element. This works if the current
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
993 buffer only sees the default value, too. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
994 Fsetcdr (current_alist_element,
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
995 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
996
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
997 /* Find the new value for CURRENT-ALIST-ELEMENT. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
998 tem1 = Fassq (symbol, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
999 if (NILP (tem1))
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1000 {
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1001 /* This buffer still sees the default value. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1002
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1003 /* If the variable is a Lisp_Some_Buffer_Local_Value,
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1004 make CURRENT-ALIST-ELEMENT point to itself,
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1005 indicating that we're seeing the default value. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1006 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1007 tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1008
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1009 /* If it's a Lisp_Buffer_Local_Value, give this buffer a
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1010 new assoc for a local value and set
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1011 CURRENT-ALIST-ELEMENT to point to that. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1012 else
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1013 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1014 tem1 = Fcons (symbol, Fcdr (current_alist_element));
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1015 current_buffer->local_var_alist =
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1016 Fcons (tem1, current_buffer->local_var_alist);
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1017 }
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1018 }
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1019 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1020 XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1021 = tem1;
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1022
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1023 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1024 XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car,
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1025 current_buffer);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1026 }
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1027 valcontents = XBUFFER_LOCAL_VALUE (valcontents)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1028 }
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1029
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1030 /* If storing void (making the symbol void), forward only through
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1031 buffer-local indicator, not through Lisp_Objfwd, etc. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1032 if (voide)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1033 store_symval_forwarding (symbol, Qnil, newval);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1034 else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1035 store_symval_forwarding (symbol, valcontents, newval);
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1036
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1037 return newval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1038 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 /* Access or set a buffer-local symbol's default value. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1042 /* Return the default value of SYMBOL, but don't check for voidness.
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1043 Return Qunbound if it is void. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1046 default_value (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1047 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 register Lisp_Object valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1051 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1052 valcontents = XSYMBOL (symbol)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 /* For a built-in buffer-local variable, get the default value
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1055 rather than letting do_symval_forwarding get the current value. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1056 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1058 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059
9364
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
1060 if (XINT (*(Lisp_Object *) (idx + (char *) &buffer_local_flags)) != 0)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1061 return *(Lisp_Object *)(idx + (char *) &buffer_defaults);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1062 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1063
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1064 /* Handle user-created local variables. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1065 if (BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1066 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1067 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1068 /* If var is set up for a buffer that lacks a local value for it,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1069 the current value is nominally the default value.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1070 But the current value slot may be more up to date, since
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1071 ordinary setq stores just that slot. So use that. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1072 Lisp_Object current_alist_element, alist_element_car;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1073 current_alist_element
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1074 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1075 alist_element_car = XCONS (current_alist_element)->car;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1076 if (EQ (alist_element_car, current_alist_element))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1077 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 else
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1079 return XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1080 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1081 /* For other variables, get the current value. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1082 return do_symval_forwarding (valcontents);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1083 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1084
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1085 DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1086 "Return T if SYMBOL has a non-void default value.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1087 This is the value that is seen in buffers that do not have their own values\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1088 for this variable.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1089 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1090 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1091 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1092 register Lisp_Object value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1093
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1094 value = default_value (symbol);
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1095 return (EQ (value, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1096 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1097
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1098 DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 "Return SYMBOL's default value.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100 This is the value that is seen in buffers that do not have their own values\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101 for this variable. The default value is meaningful for variables with\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1102 local bindings in certain buffers.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1103 (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1104 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1105 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1106 register Lisp_Object value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1107
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1108 value = default_value (symbol);
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1109 if (EQ (value, Qunbound))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1110 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1111 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1112 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1113
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1114 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1115 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1116 The default value is seen in buffers that do not have their own values\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1117 for this variable.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1118 (symbol, value)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1119 Lisp_Object symbol, value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1120 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1121 register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1123 CHECK_SYMBOL (symbol, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1124 valcontents = XSYMBOL (symbol)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1125
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1126 /* Handle variables like case-fold-search that have special slots
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1127 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1128 variables. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1129 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1130 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1131 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1132 register struct buffer *b;
9364
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
1133 register int mask = XINT (*((Lisp_Object *)
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
1134 (idx + (char *)&buffer_local_flags)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1135
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1136 if (mask > 0)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1137 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1138 *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1139 for (b = all_buffers; b; b = b->next)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1140 if (!(b->local_var_flags & mask))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1141 *(Lisp_Object *)(idx + (char *) b) = value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1142 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1143 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1144 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1145
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1146 if (!BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1147 && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1148 return Fset (symbol, value);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1149
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1150 /* Store new value into the DEFAULT-VALUE slot */
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1151 XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr = value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1152
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1153 /* If that slot is current, we must set the REALVALUE slot too */
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1154 current_alist_element
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1155 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1156 alist_element_buffer = Fcar (current_alist_element);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1157 if (EQ (alist_element_buffer, current_alist_element))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1158 store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car,
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1159 value);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1160
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1161 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1162 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1163
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1164 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
6919
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1165 "Set the default value of variable VAR to VALUE.\n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1166 VAR, the variable name, is literal (not evaluated);\n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1167 VALUE is an expression and it is evaluated.\n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1168 The default value of a variable is seen in buffers\n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1169 that do not have their own values for the variable.\n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1170 \n\
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1171 More generally, you can use multiple variables and values, as in\n\
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1172 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1173 This sets each SYMBOL's default value to the corresponding VALUE.\n\
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1174 The VALUE for the Nth SYMBOL can refer to the new default values\n\
6919
dabe7a363f28 (Fsetq_default): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6825
diff changeset
1175 of previous SYMs.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1176 (args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1177 Lisp_Object args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1178 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1179 register Lisp_Object args_left;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1180 register Lisp_Object val, symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1181 struct gcpro gcpro1;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1182
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1183 if (NILP (args))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1184 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1185
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1186 args_left = args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1187 GCPRO1 (args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1188
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1189 do
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1190 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1191 val = Feval (Fcar (Fcdr (args_left)));
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1192 symbol = Fcar (args_left);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1193 Fset_default (symbol, val);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1194 args_left = Fcdr (Fcdr (args_left));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1195 }
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1196 while (!NILP (args_left));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1197
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198 UNGCPRO;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1199 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1200 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1201
1278
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1202 /* Lisp functions for creating and removing buffer-local variables. */
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1203
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1204 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1205 1, 1, "vMake Variable Buffer Local: ",
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1206 "Make VARIABLE have a separate value for each buffer.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1207 At any time, the value for the current buffer is in effect.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1208 There is also a default value which is seen in any buffer which has not yet\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209 set its own value.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1210 Using `set' or `setq' to set the variable causes it to have a separate value\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 for the current buffer if it was previously using the default value.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 The function `default-value' gets the default value and `set-default' sets it.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1213 (variable)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1214 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1216 register Lisp_Object tem, valcontents, newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1217
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1218 CHECK_SYMBOL (variable, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1219
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1220 valcontents = XSYMBOL (variable)->value;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1221 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1222 error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1223
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1224 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1225 return variable;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1226 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1227 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1228 XMISCTYPE (XSYMBOL (variable)->value) = Lisp_Misc_Buffer_Local_Value;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1229 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1230 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 if (EQ (valcontents, Qunbound))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1232 XSYMBOL (variable)->value = Qnil;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1233 tem = Fcons (Qnil, Fsymbol_value (variable));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1234 XCONS (tem)->car = tem;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1235 newval = allocate_misc ();
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
1236 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1237 XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1238 XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Fcurrent_buffer (), tem);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1239 XSYMBOL (variable)->value = newval;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1240 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1241 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1242
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1243 DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1244 1, 1, "vMake Local Variable: ",
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1245 "Make VARIABLE have a separate value in the current buffer.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1246 Other buffers will continue to share a common default value.\n\
6825
f70a517ae9e2 (Fsetq_default, Fmake_local_variable): Doc syntax fix.
Richard M. Stallman <rms@gnu.org>
parents: 6497
diff changeset
1247 \(The buffer-local value of VARIABLE starts out as the same value\n\
f70a517ae9e2 (Fsetq_default, Fmake_local_variable): Doc syntax fix.
Richard M. Stallman <rms@gnu.org>
parents: 6497
diff changeset
1248 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1249 See also `make-variable-buffer-local'.\n\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1250 If the variable is already arranged to become local when set,\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1251 this function causes a local value to exist for this buffer,\n\
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1252 just as setting the variable would do.\n\
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1253 \n\
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1254 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1255 Use `make-local-hook' instead.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1256 (variable)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1257 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 register Lisp_Object tem, valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1261 CHECK_SYMBOL (variable, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1262
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1263 valcontents = XSYMBOL (variable)->value;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1264 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1265 error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1267 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1268 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1269 tem = Fboundp (variable);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1270
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1271 /* Make sure the symbol has a local value in this particular buffer,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1272 by setting it to the same value it already has. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1273 Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1274 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1275 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1276 /* Make sure symbol is set up to hold per-buffer values */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1277 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1278 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1279 Lisp_Object newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1280 tem = Fcons (Qnil, do_symval_forwarding (valcontents));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 XCONS (tem)->car = tem;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1282 newval = allocate_misc ();
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
1283 XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1284 XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1285 XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Qnil, tem);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1286 XSYMBOL (variable)->value = newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1288 /* Make sure this buffer has its own value of symbol */
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1289 tem = Fassq (variable, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1290 if (NILP (tem))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291 {
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1292 /* Swap out any local binding for some other buffer, and make
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1293 sure the current value is permanently recorded, if it's the
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1294 default value. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1295 find_symbol_value (variable);
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1296
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1297 current_buffer->local_var_alist
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1298 = Fcons (Fcons (variable, XCONS (XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->cdr)->cdr)->cdr),
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1299 current_buffer->local_var_alist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1300
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1301 /* Make sure symbol does not think it is set up for this buffer;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1302 force it to look once again for this buffer's value */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1304 Lisp_Object *pvalbuf;
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1305
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1306 valcontents = XSYMBOL (variable)->value;
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1307
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1308 pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1309 if (current_buffer == XBUFFER (*pvalbuf))
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1310 *pvalbuf = Qnil;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1311 }
1278
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1312 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1313
1278
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1314 /* If the symbol forwards into a C variable, then swap in the
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1315 variable for this buffer immediately. If C code modifies the
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1316 variable before we swap in, then that new value will clobber the
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1317 default value the next time we swap. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1318 valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->car;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1319 if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1320 swap_in_symval_forwarding (variable, XSYMBOL (variable)->value);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1321
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1322 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1323 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 1, 1, "vKill Local Variable: ",
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327 "Make VARIABLE no longer have a separate value in the current buffer.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 From now on the default value will apply in this buffer.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1329 (variable)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1330 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1331 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 register Lisp_Object tem, valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1333
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1334 CHECK_SYMBOL (variable, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1335
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1336 valcontents = XSYMBOL (variable)->value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1337
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1338 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1339 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1340 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
9364
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
1341 register int mask = XINT (*((Lisp_Object*)
0bba3bd707c7 (Fset, default_value, Fset_default, Fkill_local_variable): Access
Karl Heuer <kwzh@gnu.org>
parents: 9301
diff changeset
1342 (idx + (char *)&buffer_local_flags)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1343
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1344 if (mask > 0)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1345 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1346 *(Lisp_Object *)(idx + (char *) current_buffer)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 = *(Lisp_Object *)(idx + (char *) &buffer_defaults);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 current_buffer->local_var_flags &= ~mask;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1350 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1351 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1352
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1353 if (!BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1354 && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1355 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 /* Get rid of this buffer's alist element, if any */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1359 tem = Fassq (variable, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1360 if (!NILP (tem))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1361 current_buffer->local_var_alist
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1362 = Fdelq (tem, current_buffer->local_var_alist);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 /* Make sure symbol does not think it is set up for this buffer;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1365 force it to look once again for this buffer's value */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1367 Lisp_Object *pvalbuf;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1368 valcontents = XSYMBOL (variable)->value;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1369 pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1370 if (current_buffer == XBUFFER (*pvalbuf))
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1371 *pvalbuf = Qnil;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1372 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1373
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1374 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375 }
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1376
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1377 DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1378 1, 2, 0,
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1379 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1380 BUFFER defaults to the current buffer.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1381 (variable, buffer)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1382 register Lisp_Object variable, buffer;
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1383 {
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1384 Lisp_Object valcontents;
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1385 register struct buffer *buf;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1386
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1387 if (NILP (buffer))
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1388 buf = current_buffer;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1389 else
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1390 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1391 CHECK_BUFFER (buffer, 0);
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1392 buf = XBUFFER (buffer);
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1393 }
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1394
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1395 CHECK_SYMBOL (variable, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1396
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1397 valcontents = XSYMBOL (variable)->value;
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1398 if (BUFFER_LOCAL_VALUEP (valcontents)
12225
a0067d2edef7 (Flocal_variable_p): Fix backwards logical operator.
Richard M. Stallman <rms@gnu.org>
parents: 12113
diff changeset
1399 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1400 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1401 Lisp_Object tail, elt;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1402 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1403 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1404 elt = XCONS (tail)->car;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1405 if (EQ (variable, XCONS (elt)->car))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1406 return Qt;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1407 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1408 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1409 if (BUFFER_OBJFWDP (valcontents))
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1410 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1411 int offset = XBUFFER_OBJFWD (valcontents)->offset;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1412 int mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1413 if (mask == -1 || (buf->local_var_flags & mask))
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1414 return Qt;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1415 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1416 return Qnil;
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1417 }
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1418
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1419 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1420 1, 2, 0,
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1421 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1422 BUFFER defaults to the current buffer.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1423 (variable, buffer)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1424 register Lisp_Object variable, buffer;
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1425 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1426 Lisp_Object valcontents;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1427 register struct buffer *buf;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1428
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1429 if (NILP (buffer))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1430 buf = current_buffer;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1431 else
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1432 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1433 CHECK_BUFFER (buffer, 0);
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1434 buf = XBUFFER (buffer);
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1435 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1436
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1437 CHECK_SYMBOL (variable, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1438
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1439 valcontents = XSYMBOL (variable)->value;
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1440
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1441 /* This means that make-variable-buffer-local was done. */
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1442 if (BUFFER_LOCAL_VALUEP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1443 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1444 /* All these slots become local if they are set. */
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1445 if (BUFFER_OBJFWDP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1446 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1447 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1448 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1449 Lisp_Object tail, elt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1450 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1451 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1452 elt = XCONS (tail)->car;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1453 if (EQ (variable, XCONS (elt)->car))
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1454 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1455 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1456 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1457 return Qnil;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1458 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1459
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1460 /* Find the function at the end of a chain of symbol function indirections. */
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1461
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1462 /* If OBJECT is a symbol, find the end of its function chain and
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1463 return the value found there. If OBJECT is not a symbol, just
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1464 return it. If there is a cycle in the function chain, signal a
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1465 cyclic-function-indirection error.
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1466
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1467 This is like Findirect_function, except that it doesn't signal an
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1468 error if the chain ends up unbound. */
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1469 Lisp_Object
1648
27e9f99fe095 src/ * data.c (indirect_function): Delete unused argument ERROR.
Jim Blandy <jimb@redhat.com>
parents: 1508
diff changeset
1470 indirect_function (object)
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1471 register Lisp_Object object;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1472 {
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1473 Lisp_Object tortoise, hare;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1474
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1475 hare = tortoise = object;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1476
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1477 for (;;)
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1478 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1479 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1480 break;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1481 hare = XSYMBOL (hare)->function;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1482 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1483 break;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1484 hare = XSYMBOL (hare)->function;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1485
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1486 tortoise = XSYMBOL (tortoise)->function;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1487
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1488 if (EQ (hare, tortoise))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1489 Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1490 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1491
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1492 return hare;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1493 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1494
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1495 DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0,
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1496 "Return the function at the end of OBJECT's function chain.\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1497 If OBJECT is a symbol, follow all function indirections and return the final\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1498 function binding.\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1499 If OBJECT is not a symbol, just return it.\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1500 Signal a void-function error if the final symbol is unbound.\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1501 Signal a cyclic-function-indirection error if there is a loop in the\n\
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1502 function chain of symbols.")
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1503 (object)
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1504 register Lisp_Object object;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1505 {
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1506 Lisp_Object result;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1507
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1508 result = indirect_function (object);
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1509
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1510 if (EQ (result, Qunbound))
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1511 return Fsignal (Qvoid_function, Fcons (object, Qnil));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1512 return result;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1513 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1514
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515 /* Extract and set vector and string elements */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1516
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1517 DEFUN ("aref", Faref, Saref, 2, 2, 0,
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1518 "Return the element of ARRAY at index IDX.\n\
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1519 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1520 or a byte-code object. IDX starts at 0.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1521 (array, idx)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1522 register Lisp_Object array;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 Lisp_Object idx;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1524 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1525 register int idxval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1527 CHECK_NUMBER (idx, 1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 idxval = XINT (idx);
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1529 if (STRINGP (array))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1530 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1531 Lisp_Object val;
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1532 if (idxval < 0 || idxval >= XSTRING (array)->size)
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1533 args_out_of_range (array, idx);
9301
e6daff3e246f (Faref, Farray_length): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9263
diff changeset
1534 XSETFASTINT (val, (unsigned char) XSTRING (array)->data[idxval]);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1535 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1536 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1537 else if (BOOL_VECTOR_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1538 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1539 int val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1540
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1541 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1542 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1543
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1544 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1545 return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1546 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1547 else if (CHAR_TABLE_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1548 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1549 Lisp_Object val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1550
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1551 if (idxval < 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1552 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1553 #if 1
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1554 if ((unsigned) idxval >= CHAR_TABLE_ORDINARY_SLOTS)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1555 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1556 return val = XCHAR_TABLE (array)->contents[idxval];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1557 #else /* 0 */
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1558 if ((unsigned) idxval < CHAR_TABLE_ORDINARY_SLOTS)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1559 val = XCHAR_TABLE (array)->data[idxval];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1560 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1561 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1562 int charset;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1563 unsigned char c1, c2;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1564 Lisp_Object val, temp;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1565
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1566 BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1567
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1568 try_parent_char_table:
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1569 val = XCHAR_TABLE (array)->contents[charset];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1570 if (c1 == 0 || !CHAR_TABLE_P (val))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1571 return val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1572
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1573 temp = XCHAR_TABLE (val)->contents[c1];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1574 if (NILP (temp))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1575 val = XCHAR_TABLE (val)->defalt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1576 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1577 val = temp;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1578
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1579 if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1580 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1581 array = XCHAR_TABLE (array)->parent;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1582 goto try_parent_char_table;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1583
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1584 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1585
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1586 if (c2 == 0 || !CHAR_TABLE_P (val))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1587 return val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1588
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1589 temp = XCHAR_TABLE (val)->contents[c2];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1590 if (NILP (temp))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1591 val = XCHAR_TABLE (val)->defalt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1592 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1593 val = temp;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1594
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1595 if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1596 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1597 array = XCHAR_TABLE (array)->parent;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1598 goto try_parent_char_table;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1599 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1600
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1601 return val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1602 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1603 #endif /* 0 */
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1604 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1605 else
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1606 {
10290
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1607 int size;
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1608 if (VECTORP (array))
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1609 size = XVECTOR (array)->size;
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1610 else if (COMPILEDP (array))
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1611 size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1612 else
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1613 wrong_type_argument (Qarrayp, array);
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1614
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
1615 if (idxval < 0 || idxval >= size)
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1616 args_out_of_range (array, idx);
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1617 return XVECTOR (array)->contents[idxval];
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1618 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1619 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1620
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1621 DEFUN ("aset", Faset, Saset, 3, 3, 0,
5660
0951c61a12f8 (Faset): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5504
diff changeset
1622 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
0951c61a12f8 (Faset): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5504
diff changeset
1623 ARRAY may be a vector or a string. IDX starts at 0.")
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 (array, idx, newelt)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1625 register Lisp_Object array;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1626 Lisp_Object idx, newelt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628 register int idxval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1630 CHECK_NUMBER (idx, 1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 idxval = XINT (idx);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1632 if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1633 && ! CHAR_TABLE_P (array))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 array = wrong_type_argument (Qarrayp, array);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1635 CHECK_IMPURE (array);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1637 if (VECTORP (array))
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1638 {
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1639 if (idxval < 0 || idxval >= XVECTOR (array)->size)
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1640 args_out_of_range (array, idx);
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1641 XVECTOR (array)->contents[idxval] = newelt;
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1642 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1643 else if (BOOL_VECTOR_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1644 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1645 int val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1646
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1647 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1648 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1649
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1650 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1651
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1652 if (! NILP (newelt))
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1653 val |= 1 << (idxval % BITS_PER_CHAR);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1654 else
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1655 val &= ~(1 << (idxval % BITS_PER_CHAR));
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13296
diff changeset
1656 XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1657 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1658 else if (CHAR_TABLE_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1659 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1660 Lisp_Object val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1661
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1662 if (idxval < 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1663 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1664 #if 1
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1665 if (idxval >= CHAR_TABLE_ORDINARY_SLOTS)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1666 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1667 XCHAR_TABLE (array)->contents[idxval] = newelt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1668 return newelt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1669 #else /* 0 */
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1670 if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1671 val = XCHAR_TABLE (array)->contents[idxval];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1672 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1673 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1674 int charset;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1675 unsigned char c1, c2;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1676 Lisp_Object val, val2;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1677
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1678 BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1679
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1680 if (c1 == 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1681 return XCHAR_TABLE (array)->contents[charset] = newelt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1682
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1683 val = XCHAR_TABLE (array)->contents[charset];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1684 if (!CHAR_TABLE_P (val))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1685 XCHAR_TABLE (array)->contents[charset]
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1686 = val = Fmake_char_table (Qnil);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1687
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1688 if (c2 == 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1689 return XCHAR_TABLE (val)->contents[c1] = newelt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1690
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1691 val2 = XCHAR_TABLE (val)->contents[c2];
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1692 if (!CHAR_TABLE_P (val2))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1693 XCHAR_TABLE (val)->contents[charset]
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1694 = val2 = Fmake_char_table (Qnil);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1695
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1696 return XCHAR_TABLE (val2)->contents[c2] = newelt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1697 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1698 #endif /* 0 */
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1699 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701 {
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1702 if (idxval < 0 || idxval >= XSTRING (array)->size)
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1703 args_out_of_range (array, idx);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1704 CHECK_NUMBER (newelt, 2);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1705 XSTRING (array)->data[idxval] = XINT (newelt);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1708 return newelt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1709 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711 /* Arithmetic functions */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1712
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1715 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716 arithcompare (num1, num2, comparison)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718 enum comparison comparison;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 double f1, f2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 int floatp = 0;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1724 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1725 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1726
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1727 if (FLOATP (num1) || FLOATP (num2))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1729 floatp = 1;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1730 f1 = (FLOATP (num1)) ? XFLOAT (num1)->data : XINT (num1);
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1731 f2 = (FLOATP (num2)) ? XFLOAT (num2)->data : XINT (num2);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1732 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1733 #else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1734 CHECK_NUMBER_COERCE_MARKER (num1, 0);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1735 CHECK_NUMBER_COERCE_MARKER (num2, 0);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1737
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1738 switch (comparison)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1740 case equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741 if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745 case notequal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1746 if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1747 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1749
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1750 case less:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1751 if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1752 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1753 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 case less_or_equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756 if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 case grtr:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761 if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 case grtr_or_equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 return Qnil;
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1769
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1770 default:
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1771 abort ();
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1774
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1775 DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1776 "T if two args, both numbers or markers, are equal.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1777 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1780 return arithcompare (num1, num2, equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1781 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1782
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1783 DEFUN ("<", Flss, Slss, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 "T if first arg is less than second arg. Both must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1787 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788 return arithcompare (num1, num2, less);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1789 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 "T if first arg is greater than second arg. Both must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 return arithcompare (num1, num2, grtr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 "T if first arg is less than or equal to second arg.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801 Both must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1803 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1804 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1805 return arithcompare (num1, num2, less_or_equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1806 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809 "T if first arg is greater than or equal to second arg.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1810 Both must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1811 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1812 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1814 return arithcompare (num1, num2, grtr_or_equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1815 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1816
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1817 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1818 "T if first arg is not equal to second arg. Both must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1819 (num1, num2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1820 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1821 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1822 return arithcompare (num1, num2, notequal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1824
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1825 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1826 (number)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1827 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1828 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1829 #ifdef LISP_FLOAT_TYPE
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1830 CHECK_NUMBER_OR_FLOAT (number, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1831
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1832 if (FLOATP (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1833 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1834 if (XFLOAT(number)->data == 0.0)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1835 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1836 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1837 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1838 #else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1839 CHECK_NUMBER (number, 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1840 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1841
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1842 if (!XINT (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1843 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1844 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1845 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1846
12043
4aed79cc70b7 Comment change.
Karl Heuer <kwzh@gnu.org>
parents: 11879
diff changeset
1847 /* Convert between long values and pairs of Lisp integers. */
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1848
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1849 Lisp_Object
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1850 long_to_cons (i)
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1851 unsigned long i;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1852 {
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1853 unsigned int top = i >> 16;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1854 unsigned int bot = i & 0xFFFF;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1855 if (top == 0)
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1856 return make_number (bot);
11879
606889516975 (long_to_cons): Don't assume 32-bit longs.
Karl Heuer <kwzh@gnu.org>
parents: 11734
diff changeset
1857 if (top == (unsigned long)-1 >> 16)
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1858 return Fcons (make_number (-1), make_number (bot));
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1859 return Fcons (make_number (top), make_number (bot));
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1860 }
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1861
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1862 unsigned long
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1863 cons_to_long (c)
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1864 Lisp_Object c;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1865 {
3675
f42eaf84478f (cons_to_long): Declare top, bot as Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1866 Lisp_Object top, bot;
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1867 if (INTEGERP (c))
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1868 return XINT (c);
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1869 top = XCONS (c)->car;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1870 bot = XCONS (c)->cdr;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1871 if (CONSP (bot))
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1872 bot = XCONS (bot)->car;
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1873 return ((XINT (top) << 16) | XINT (bot));
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1874 }
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
1875
2429
96b55f2f19cd Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents: 2092
diff changeset
1876 DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1877 "Convert NUMBER to a string by printing it in decimal.\n\
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1878 Uses a minus sign if negative.\n\
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1879 NUMBER may be an integer or a floating point number.")
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1880 (number)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1881 Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1882 {
12528
ed5b91dd829a (Fnumber_to_string): Make `buffer' long enough.
Karl Heuer <kwzh@gnu.org>
parents: 12295
diff changeset
1883 char buffer[VALBITS];
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1884
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1885 #ifndef LISP_FLOAT_TYPE
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1886 CHECK_NUMBER (number, 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1887 #else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1888 CHECK_NUMBER_OR_FLOAT (number, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1889
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1890 if (FLOATP (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1891 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1892 char pigbuf[350]; /* see comments in float_to_string */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1893
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1894 float_to_string (pigbuf, XFLOAT(number)->data);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1895 return build_string (pigbuf);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1896 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1897 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1898
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1899 if (sizeof (int) == sizeof (EMACS_INT))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1900 sprintf (buffer, "%d", XINT (number));
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1901 else if (sizeof (long) == sizeof (EMACS_INT))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1902 sprintf (buffer, "%ld", XINT (number));
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1903 else
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1904 abort ();
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1905 return build_string (buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1907
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1908 DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 0,
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1909 "Convert STRING to a number by parsing it as a decimal number.\n\
6448
9d04c87e0da1 (Fstring_to_number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6446
diff changeset
1910 This parses both integers and floating point numbers.\n\
9d04c87e0da1 (Fstring_to_number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6446
diff changeset
1911 It ignores leading spaces and tabs.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1912 (string)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1913 register Lisp_Object string;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1914 {
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1915 Lisp_Object value;
1987
cd893024d6b9 * data.c (Fstring_to_number): Declare p to be an unsigned char, to
Jim Blandy <jimb@redhat.com>
parents: 1914
diff changeset
1916 unsigned char *p;
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1917
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1918 CHECK_STRING (string, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1919
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1920 p = XSTRING (string)->data;
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1921
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1922 /* Skip any whitespace at the front of the number. Some versions of
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1923 atoi do this anyway, so we might as well make Emacs lisp consistent. */
1987
cd893024d6b9 * data.c (Fstring_to_number): Declare p to be an unsigned char, to
Jim Blandy <jimb@redhat.com>
parents: 1914
diff changeset
1924 while (*p == ' ' || *p == '\t')
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1925 p++;
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1926
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1927 #ifdef LISP_FLOAT_TYPE
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1928 if (isfloat_string (p))
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1929 return make_float (atof (p));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1932 if (sizeof (int) == sizeof (EMACS_INT))
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1933 XSETINT (value, atoi (p));
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1934 else if (sizeof (long) == sizeof (EMACS_INT))
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1935 XSETINT (value, atol (p));
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1936 else
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1937 abort ();
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
1938 return value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1939 }
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1940
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 enum arithop
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943
1508
768d4c10c2bf * data.c (Fset): See if current_alist_element points to itself
Jim Blandy <jimb@redhat.com>
parents: 1293
diff changeset
1944 extern Lisp_Object float_arith_driver ();
768d4c10c2bf * data.c (Fset): See if current_alist_element points to itself
Jim Blandy <jimb@redhat.com>
parents: 1293
diff changeset
1945
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 Lisp_Object
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1947 arith_driver (code, nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948 enum arithop code;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950 register Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 register int argnum;
11688
f1e6033d8aca (arith_driver): Make accum and next EMACS_INTs.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
1954 register EMACS_INT accum;
f1e6033d8aca (arith_driver): Make accum and next EMACS_INTs.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
1955 register EMACS_INT next;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1956
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
1957 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 case Alogior:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960 case Alogxor:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961 case Aadd:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962 case Asub:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1963 accum = 0; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1964 case Amult:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 accum = 1; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966 case Alogand:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 accum = -1; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1969
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970 for (argnum = 0; argnum < nargs; argnum++)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1976 if (FLOATP (val)) /* time to do serious math */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1977 return (float_arith_driver ((double) accum, argnum, code,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 nargs, args));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1979 #else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 CHECK_NUMBER_COERCE_MARKER (val, argnum);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1982 args[argnum] = val; /* runs into a compiler bug. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1983 next = XINT (args[argnum]);
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
1984 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1985 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1986 case Aadd: accum += next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 case Asub:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 if (!argnum && nargs != 1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1989 next = - next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1990 accum -= next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1991 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1992 case Amult: accum *= next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1993 case Adiv:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1994 if (!argnum) accum = next;
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1995 else
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1996 {
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1997 if (next == 0)
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1998 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
1999 accum /= next;
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2000 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 case Alogand: accum &= next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2003 case Alogior: accum |= next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2004 case Alogxor: accum ^= next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2005 case Amax: if (!argnum || next > accum) accum = next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2006 case Amin: if (!argnum || next < accum) accum = next; break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2007 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2009
9263
cda13734e32c (make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
parents: 9194
diff changeset
2010 XSETINT (val, accum);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2011 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 #ifdef LISP_FLOAT_TYPE
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2015
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2016 #undef isnan
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2017 #define isnan(x) ((x) != (x))
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2018
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2019 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2020 float_arith_driver (accum, argnum, code, nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2021 double accum;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2022 register int argnum;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2023 enum arithop code;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2024 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2025 register Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2026 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2027 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028 double next;
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2029
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2030 for (; argnum < nargs; argnum++)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2031 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2032 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2033 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2034
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
2035 if (FLOATP (val))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2036 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2037 next = XFLOAT (val)->data;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2038 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2041 args[argnum] = val; /* runs into a compiler bug. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2042 next = XINT (args[argnum]);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2043 }
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
2044 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2045 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2046 case Aadd:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2047 accum += next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2048 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2049 case Asub:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2050 if (!argnum && nargs != 1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2051 next = - next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2052 accum -= next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2053 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2054 case Amult:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2055 accum *= next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2056 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2057 case Adiv:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2058 if (!argnum)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2059 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2060 else
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2061 {
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2062 if (next == 0)
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2063 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2064 accum /= next;
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2065 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2066 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2067 case Alogand:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2068 case Alogior:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2069 case Alogxor:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2070 return wrong_type_argument (Qinteger_or_marker_p, val);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2071 case Amax:
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2072 if (!argnum || isnan (next) || next > accum)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2073 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2074 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2075 case Amin:
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2076 if (!argnum || isnan (next) || next < accum)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2077 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2078 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2079 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2080 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2081
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2082 return make_float (accum);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2083 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2084 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2085
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2086 DEFUN ("+", Fplus, Splus, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087 "Return sum of any number of arguments, which are numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2088 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2089 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2090 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2091 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2092 return arith_driver (Aadd, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2093 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2094
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2095 DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2096 "Negate number or subtract numbers or markers.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2097 With one arg, negates it. With more than one arg,\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2098 subtracts all but the first from the first.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2099 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2100 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2101 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2102 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2103 return arith_driver (Asub, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2104 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2105
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2106 DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2107 "Returns product of any number of arguments, which are numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2108 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2109 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2110 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2111 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2112 return arith_driver (Amult, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2113 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2114
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2115 DEFUN ("/", Fquo, Squo, 2, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2116 "Returns first argument divided by all the remaining arguments.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2117 The arguments must be numbers or markers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2118 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2119 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2120 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2121 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2122 return arith_driver (Adiv, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2123 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2124
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2125 DEFUN ("%", Frem, Srem, 2, 2, 0,
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2126 "Returns remainder of X divided by Y.\n\
4447
ba273b48143b (Frem): Don't accept floats, just ints and markers.
Richard M. Stallman <rms@gnu.org>
parents: 4037
diff changeset
2127 Both must be integers or markers.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2128 (x, y)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2129 register Lisp_Object x, y;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2130 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2131 Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2132
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2133 CHECK_NUMBER_COERCE_MARKER (x, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2134 CHECK_NUMBER_COERCE_MARKER (y, 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2135
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2136 if (XFASTINT (y) == 0)
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2137 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2138
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2139 XSETINT (val, XINT (x) % XINT (y));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2140 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2141 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2142
5776
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2143 #ifndef HAVE_FMOD
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2144 double
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2145 fmod (f1, f2)
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2146 double f1, f2;
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2147 {
13296
76034e1fc62e [!HAVE_FMOD] (fmod): Make consistent with ANSI definition.
Karl Heuer <kwzh@gnu.org>
parents: 13200
diff changeset
2148 if (f2 < 0.0)
76034e1fc62e [!HAVE_FMOD] (fmod): Make consistent with ANSI definition.
Karl Heuer <kwzh@gnu.org>
parents: 13200
diff changeset
2149 f2 = -f2;
5776
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2150 return (f1 - f2 * floor (f1/f2));
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2151 }
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2152 #endif /* ! HAVE_FMOD */
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2153
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2154 DEFUN ("mod", Fmod, Smod, 2, 2, 0,
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2155 "Returns X modulo Y.\n\
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2156 The result falls between zero (inclusive) and Y (exclusive).\n\
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2157 Both X and Y must be numbers or markers.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2158 (x, y)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2159 register Lisp_Object x, y;
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2160 {
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2161 Lisp_Object val;
11688
f1e6033d8aca (arith_driver): Make accum and next EMACS_INTs.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
2162 EMACS_INT i1, i2;
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2163
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2164 #ifdef LISP_FLOAT_TYPE
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2165 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2166 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y, 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2167
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2168 if (FLOATP (x) || FLOATP (y))
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2169 {
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2170 double f1, f2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2171
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2172 f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2173 f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2174 if (f2 == 0)
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2175 Fsignal (Qarith_error, Qnil);
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2176
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2177 f1 = fmod (f1, f2);
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2178 /* If the "remainder" comes out with the wrong sign, fix it. */
11734
e6675e3ed8b3 (Fmod): Fix the final adjustment, when f2 < 0 and f1 == 0.
Richard M. Stallman <rms@gnu.org>
parents: 11701
diff changeset
2179 if (f2 < 0 ? f1 > 0 : f1 < 0)
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2180 f1 += f2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2181 return (make_float (f1));
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2182 }
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2183 #else /* not LISP_FLOAT_TYPE */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2184 CHECK_NUMBER_COERCE_MARKER (x, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2185 CHECK_NUMBER_COERCE_MARKER (y, 1);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2186 #endif /* not LISP_FLOAT_TYPE */
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2187
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2188 i1 = XINT (x);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2189 i2 = XINT (y);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2190
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2191 if (i2 == 0)
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2192 Fsignal (Qarith_error, Qnil);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2193
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2194 i1 %= i2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2195
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2196 /* If the "remainder" comes out with the wrong sign, fix it. */
11155
0aede77c1593 (Fmod): Fix the final adjustment, when i2 < 0 and i1 == 0.
Richard M. Stallman <rms@gnu.org>
parents: 11019
diff changeset
2197 if (i2 < 0 ? i1 > 0 : i1 < 0)
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2198 i1 += i2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2199
9263
cda13734e32c (make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
parents: 9194
diff changeset
2200 XSETINT (val, i1);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2201 return val;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2202 }
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2203
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2204 DEFUN ("max", Fmax, Smax, 1, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2205 "Return largest of all the arguments (which must be numbers or markers).\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 The value is always a number; markers are converted to numbers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2207 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2208 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2209 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2210 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2211 return arith_driver (Amax, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2212 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2213
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2214 DEFUN ("min", Fmin, Smin, 1, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2215 "Return smallest of all the arguments (which must be numbers or markers).\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2216 The value is always a number; markers are converted to numbers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2217 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2218 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2219 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2220 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2221 return arith_driver (Amin, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2222 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2223
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2224 DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2225 "Return bitwise-and of all the arguments.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2226 Arguments may be integers, or markers converted to integers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2227 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2228 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2229 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2230 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2231 return arith_driver (Alogand, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2232 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2233
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2234 DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2235 "Return bitwise-or of all the arguments.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2236 Arguments may be integers, or markers converted to integers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2237 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2238 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2239 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2240 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2241 return arith_driver (Alogior, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2242 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2243
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2244 DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2245 "Return bitwise-exclusive-or of all the arguments.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2246 Arguments may be integers, or markers converted to integers.")
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2247 (nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2248 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2249 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2250 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2251 return arith_driver (Alogxor, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2252 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2253
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 DEFUN ("ash", Fash, Sash, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2255 "Return VALUE with its bits shifted left by COUNT.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2256 If COUNT is negative, shifting is actually to the right.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2257 In this case, the sign bit is duplicated.")
11002
ff115809a39e (Fash): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 10951
diff changeset
2258 (value, count)
ff115809a39e (Fash): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 10951
diff changeset
2259 register Lisp_Object value, count;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2260 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2261 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2262
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2263 CHECK_NUMBER (value, 0);
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2264 CHECK_NUMBER (count, 1);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2265
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2266 if (XINT (count) > 0)
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2267 XSETINT (val, XINT (value) << XFASTINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2268 else
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2269 XSETINT (val, XINT (value) >> -XINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2270 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274 "Return VALUE with its bits shifted left by COUNT.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2275 If COUNT is negative, shifting is actually to the right.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2276 In this case, zeros are shifted in on the left.")
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2277 (value, count)
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2278 register Lisp_Object value, count;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2279 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2281
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2282 CHECK_NUMBER (value, 0);
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2283 CHECK_NUMBER (count, 1);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2285 if (XINT (count) > 0)
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2286 XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287 else
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2288 XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2289 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2290 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2292 DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2293 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2294 Markers are converted to integers.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2295 (number)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2296 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2297 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2298 #ifdef LISP_FLOAT_TYPE
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2299 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2300
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2301 if (FLOATP (number))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2302 return (make_float (1.0 + XFLOAT (number)->data));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303 #else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2304 CHECK_NUMBER_COERCE_MARKER (number, 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2306
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2307 XSETINT (number, XINT (number) + 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2308 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2309 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2310
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311 DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2312 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2313 Markers are converted to integers.")
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2314 (number)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2315 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2316 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2317 #ifdef LISP_FLOAT_TYPE
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2318 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number, 0);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2319
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2320 if (FLOATP (number))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2321 return (make_float (-1.0 + XFLOAT (number)->data));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2322 #else
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2323 CHECK_NUMBER_COERCE_MARKER (number, 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2324 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2325
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2326 XSETINT (number, XINT (number) - 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2327 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2330 DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2331 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2332 (number)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2333 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2334 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2335 CHECK_NUMBER (number, 0);
14096
f3766d691555 (Flognot): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 14066
diff changeset
2336 XSETINT (number, ~XINT (number));
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2337 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2339
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2340 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 syms_of_data ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 {
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2343 Lisp_Object error_tail, arith_tail;
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2344
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345 Qquote = intern ("quote");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2346 Qlambda = intern ("lambda");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2347 Qsubr = intern ("subr");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2348 Qerror_conditions = intern ("error-conditions");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2349 Qerror_message = intern ("error-message");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2350 Qtop_level = intern ("top-level");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2351
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2352 Qerror = intern ("error");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 Qquit = intern ("quit");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 Qwrong_type_argument = intern ("wrong-type-argument");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355 Qargs_out_of_range = intern ("args-out-of-range");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 Qvoid_function = intern ("void-function");
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2357 Qcyclic_function_indirection = intern ("cyclic-function-indirection");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358 Qvoid_variable = intern ("void-variable");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2359 Qsetting_constant = intern ("setting-constant");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2360 Qinvalid_read_syntax = intern ("invalid-read-syntax");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2361
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 Qinvalid_function = intern ("invalid-function");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364 Qno_catch = intern ("no-catch");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 Qend_of_file = intern ("end-of-file");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 Qarith_error = intern ("arith-error");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2367 Qbeginning_of_buffer = intern ("beginning-of-buffer");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2368 Qend_of_buffer = intern ("end-of-buffer");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2369 Qbuffer_read_only = intern ("buffer-read-only");
4036
fbbd3e138284 Define Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 3675
diff changeset
2370 Qmark_inactive = intern ("mark-inactive");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2371
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2372 Qlistp = intern ("listp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2373 Qconsp = intern ("consp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2374 Qsymbolp = intern ("symbolp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2375 Qintegerp = intern ("integerp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2376 Qnatnump = intern ("natnump");
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
2377 Qwholenump = intern ("wholenump");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2378 Qstringp = intern ("stringp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2379 Qarrayp = intern ("arrayp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2380 Qsequencep = intern ("sequencep");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2381 Qbufferp = intern ("bufferp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2382 Qvectorp = intern ("vectorp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2383 Qchar_or_string_p = intern ("char-or-string-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2384 Qmarkerp = intern ("markerp");
1293
95ae0805ebba Qbuffer_or_string_p added.
Joseph Arceneaux <jla@gnu.org>
parents: 1278
diff changeset
2385 Qbuffer_or_string_p = intern ("buffer-or-string-p");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2386 Qinteger_or_marker_p = intern ("integer-or-marker-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2387 Qboundp = intern ("boundp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2388 Qfboundp = intern ("fboundp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2389
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2390 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2391 Qfloatp = intern ("floatp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2392 Qnumberp = intern ("numberp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2393 Qnumber_or_marker_p = intern ("number-or-marker-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2394 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2395
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2396 Qchar_table_p = intern ("char-table-p");
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
2397 Qvector_or_char_table_p = intern ("vector-or-char-table-p");
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2398
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2399 Qcdr = intern ("cdr");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2400
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
2401 /* Handle automatic advice activation */
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
2402 Qad_advice_info = intern ("ad-advice-info");
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
2403 Qad_activate = intern ("ad-activate");
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
2404
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2405 error_tail = Fcons (Qerror, Qnil);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2406
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2407 /* ERROR is used as a signaler for random errors for which nothing else is right */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2408
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2409 Fput (Qerror, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2410 error_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2411 Fput (Qerror, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2412 build_string ("error"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2413
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2414 Fput (Qquit, Qerror_conditions,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2415 Fcons (Qquit, Qnil));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2416 Fput (Qquit, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2417 build_string ("Quit"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2418
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2419 Fput (Qwrong_type_argument, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2420 Fcons (Qwrong_type_argument, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2421 Fput (Qwrong_type_argument, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2422 build_string ("Wrong type argument"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2423
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2424 Fput (Qargs_out_of_range, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2425 Fcons (Qargs_out_of_range, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2426 Fput (Qargs_out_of_range, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2427 build_string ("Args out of range"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2428
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2429 Fput (Qvoid_function, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2430 Fcons (Qvoid_function, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2431 Fput (Qvoid_function, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2432 build_string ("Symbol's function definition is void"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2433
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2434 Fput (Qcyclic_function_indirection, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2435 Fcons (Qcyclic_function_indirection, error_tail));
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2436 Fput (Qcyclic_function_indirection, Qerror_message,
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2437 build_string ("Symbol's chain of function indirections contains a loop"));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2438
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2439 Fput (Qvoid_variable, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2440 Fcons (Qvoid_variable, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441 Fput (Qvoid_variable, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442 build_string ("Symbol's value as variable is void"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2443
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2444 Fput (Qsetting_constant, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2445 Fcons (Qsetting_constant, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2446 Fput (Qsetting_constant, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2447 build_string ("Attempt to set a constant symbol"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2448
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2449 Fput (Qinvalid_read_syntax, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2450 Fcons (Qinvalid_read_syntax, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2451 Fput (Qinvalid_read_syntax, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2452 build_string ("Invalid read syntax"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2453
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2454 Fput (Qinvalid_function, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2455 Fcons (Qinvalid_function, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456 Fput (Qinvalid_function, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 build_string ("Invalid function"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2458
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2459 Fput (Qwrong_number_of_arguments, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2460 Fcons (Qwrong_number_of_arguments, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2461 Fput (Qwrong_number_of_arguments, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2462 build_string ("Wrong number of arguments"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2463
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464 Fput (Qno_catch, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2465 Fcons (Qno_catch, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2466 Fput (Qno_catch, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2467 build_string ("No catch for tag"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2468
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2469 Fput (Qend_of_file, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2470 Fcons (Qend_of_file, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2471 Fput (Qend_of_file, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2472 build_string ("End of file during parsing"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2473
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2474 arith_tail = Fcons (Qarith_error, error_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2475 Fput (Qarith_error, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2476 arith_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2477 Fput (Qarith_error, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2478 build_string ("Arithmetic error"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2479
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2480 Fput (Qbeginning_of_buffer, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2481 Fcons (Qbeginning_of_buffer, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2482 Fput (Qbeginning_of_buffer, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2483 build_string ("Beginning of buffer"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2484
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2485 Fput (Qend_of_buffer, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2486 Fcons (Qend_of_buffer, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2487 Fput (Qend_of_buffer, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2488 build_string ("End of buffer"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2489
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2490 Fput (Qbuffer_read_only, Qerror_conditions,
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2491 Fcons (Qbuffer_read_only, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2492 Fput (Qbuffer_read_only, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2493 build_string ("Buffer is read-only"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2494
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2495 #ifdef LISP_FLOAT_TYPE
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2496 Qrange_error = intern ("range-error");
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2497 Qdomain_error = intern ("domain-error");
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2498 Qsingularity_error = intern ("singularity-error");
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2499 Qoverflow_error = intern ("overflow-error");
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2500 Qunderflow_error = intern ("underflow-error");
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2501
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2502 Fput (Qdomain_error, Qerror_conditions,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2503 Fcons (Qdomain_error, arith_tail));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2504 Fput (Qdomain_error, Qerror_message,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2505 build_string ("Arithmetic domain error"));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2506
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2507 Fput (Qrange_error, Qerror_conditions,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2508 Fcons (Qrange_error, arith_tail));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2509 Fput (Qrange_error, Qerror_message,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2510 build_string ("Arithmetic range error"));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2511
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2512 Fput (Qsingularity_error, Qerror_conditions,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2513 Fcons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2514 Fput (Qsingularity_error, Qerror_message,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2515 build_string ("Arithmetic singularity error"));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2516
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2517 Fput (Qoverflow_error, Qerror_conditions,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2518 Fcons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2519 Fput (Qoverflow_error, Qerror_message,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2520 build_string ("Arithmetic overflow error"));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2521
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2522 Fput (Qunderflow_error, Qerror_conditions,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2523 Fcons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2524 Fput (Qunderflow_error, Qerror_message,
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2525 build_string ("Arithmetic underflow error"));
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2526
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2527 staticpro (&Qrange_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2528 staticpro (&Qdomain_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2529 staticpro (&Qsingularity_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2530 staticpro (&Qoverflow_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2531 staticpro (&Qunderflow_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2532 #endif /* LISP_FLOAT_TYPE */
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2533
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2534 staticpro (&Qnil);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 staticpro (&Qt);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536 staticpro (&Qquote);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2537 staticpro (&Qlambda);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2538 staticpro (&Qsubr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539 staticpro (&Qunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 staticpro (&Qerror_conditions);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2541 staticpro (&Qerror_message);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 staticpro (&Qtop_level);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2543
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2544 staticpro (&Qerror);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2545 staticpro (&Qquit);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2546 staticpro (&Qwrong_type_argument);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547 staticpro (&Qargs_out_of_range);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548 staticpro (&Qvoid_function);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2549 staticpro (&Qcyclic_function_indirection);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2550 staticpro (&Qvoid_variable);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2551 staticpro (&Qsetting_constant);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2552 staticpro (&Qinvalid_read_syntax);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2553 staticpro (&Qwrong_number_of_arguments);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2554 staticpro (&Qinvalid_function);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2555 staticpro (&Qno_catch);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2556 staticpro (&Qend_of_file);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2557 staticpro (&Qarith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2558 staticpro (&Qbeginning_of_buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559 staticpro (&Qend_of_buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2560 staticpro (&Qbuffer_read_only);
4037
aecb99c65ab0 (syms_of_data): Staticpro Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 4036
diff changeset
2561 staticpro (&Qmark_inactive);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2562
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2563 staticpro (&Qlistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564 staticpro (&Qconsp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 staticpro (&Qsymbolp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566 staticpro (&Qintegerp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 staticpro (&Qnatnump);
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
2568 staticpro (&Qwholenump);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569 staticpro (&Qstringp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2570 staticpro (&Qarrayp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2571 staticpro (&Qsequencep);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2572 staticpro (&Qbufferp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2573 staticpro (&Qvectorp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574 staticpro (&Qchar_or_string_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2575 staticpro (&Qmarkerp);
1293
95ae0805ebba Qbuffer_or_string_p added.
Joseph Arceneaux <jla@gnu.org>
parents: 1278
diff changeset
2576 staticpro (&Qbuffer_or_string_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2577 staticpro (&Qinteger_or_marker_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2579 staticpro (&Qfloatp);
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
2580 staticpro (&Qnumberp);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
2581 staticpro (&Qnumber_or_marker_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2582 #endif /* LISP_FLOAT_TYPE */
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2583 staticpro (&Qchar_table_p);
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
2584 staticpro (&Qvector_or_char_table_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2585
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2586 staticpro (&Qboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2587 staticpro (&Qfboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2588 staticpro (&Qcdr);
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
2589 staticpro (&Qad_advice_info);
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
2590 staticpro (&Qad_activate);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2592 /* Types that type-of returns. */
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2593 Qinteger = intern ("integer");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2594 Qsymbol = intern ("symbol");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2595 Qstring = intern ("string");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2596 Qcons = intern ("cons");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2597 Qmarker = intern ("marker");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2598 Qoverlay = intern ("overlay");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2599 Qfloat = intern ("float");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2600 Qwindow_configuration = intern ("window-configuration");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2601 Qprocess = intern ("process");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2602 Qwindow = intern ("window");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2603 /* Qsubr = intern ("subr"); */
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2604 Qcompiled_function = intern ("compiled-function");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2605 Qbuffer = intern ("buffer");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2606 Qframe = intern ("frame");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2607 Qvector = intern ("vector");
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
2608 Qchar_table = intern ("char-table");
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
2609 Qbool_vector = intern ("bool-vector");
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2610
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2611 staticpro (&Qinteger);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2612 staticpro (&Qsymbol);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2613 staticpro (&Qstring);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2614 staticpro (&Qcons);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2615 staticpro (&Qmarker);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2616 staticpro (&Qoverlay);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2617 staticpro (&Qfloat);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2618 staticpro (&Qwindow_configuration);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2619 staticpro (&Qprocess);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2620 staticpro (&Qwindow);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2621 /* staticpro (&Qsubr); */
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2622 staticpro (&Qcompiled_function);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2623 staticpro (&Qbuffer);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2624 staticpro (&Qframe);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2625 staticpro (&Qvector);
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
2626 staticpro (&Qchar_table);
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
2627 staticpro (&Qbool_vector);
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2628
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2629 defsubr (&Seq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 defsubr (&Snull);
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
2631 defsubr (&Stype_of);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2632 defsubr (&Slistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2633 defsubr (&Snlistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634 defsubr (&Sconsp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2635 defsubr (&Satom);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2636 defsubr (&Sintegerp);
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
2637 defsubr (&Sinteger_or_marker_p);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
2638 defsubr (&Snumberp);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
2639 defsubr (&Snumber_or_marker_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640 #ifdef LISP_FLOAT_TYPE
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2641 defsubr (&Sfloatp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642 #endif /* LISP_FLOAT_TYPE */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2643 defsubr (&Snatnump);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2644 defsubr (&Ssymbolp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2645 defsubr (&Sstringp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2646 defsubr (&Svectorp);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2647 defsubr (&Schar_table_p);
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
2648 defsubr (&Svector_or_char_table_p);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2649 defsubr (&Sbool_vector_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2650 defsubr (&Sarrayp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 defsubr (&Ssequencep);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2652 defsubr (&Sbufferp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2653 defsubr (&Smarkerp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2654 defsubr (&Ssubrp);
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
2655 defsubr (&Sbyte_code_function_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2656 defsubr (&Schar_or_string_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2657 defsubr (&Scar);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2658 defsubr (&Scdr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2659 defsubr (&Scar_safe);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2660 defsubr (&Scdr_safe);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2661 defsubr (&Ssetcar);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2662 defsubr (&Ssetcdr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2663 defsubr (&Ssymbol_function);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2664 defsubr (&Sindirect_function);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2665 defsubr (&Ssymbol_plist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2666 defsubr (&Ssymbol_name);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2667 defsubr (&Smakunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2668 defsubr (&Sfmakunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2669 defsubr (&Sboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 defsubr (&Sfboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2671 defsubr (&Sfset);
2565
c1a1557bffde (Fdefine_function): Changed name back to Fdefalias, so we get things
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2548
diff changeset
2672 defsubr (&Sdefalias);
2606
6bf6499fe4db (Fdefine_function): New function (same code as Fdefalias).
Richard M. Stallman <rms@gnu.org>
parents: 2565
diff changeset
2673 defsubr (&Sdefine_function);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674 defsubr (&Ssetplist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675 defsubr (&Ssymbol_value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2676 defsubr (&Sset);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2677 defsubr (&Sdefault_boundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2678 defsubr (&Sdefault_value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679 defsubr (&Sset_default);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2680 defsubr (&Ssetq_default);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2681 defsubr (&Smake_variable_buffer_local);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2682 defsubr (&Smake_local_variable);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 defsubr (&Skill_local_variable);
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
2684 defsubr (&Slocal_variable_p);
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
2685 defsubr (&Slocal_variable_if_set_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686 defsubr (&Saref);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 defsubr (&Saset);
2429
96b55f2f19cd Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents: 2092
diff changeset
2688 defsubr (&Snumber_to_string);
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2689 defsubr (&Sstring_to_number);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2690 defsubr (&Seqlsign);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2691 defsubr (&Slss);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2692 defsubr (&Sgtr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2693 defsubr (&Sleq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2694 defsubr (&Sgeq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2695 defsubr (&Sneq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2696 defsubr (&Szerop);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2697 defsubr (&Splus);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698 defsubr (&Sminus);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 defsubr (&Stimes);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700 defsubr (&Squo);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 defsubr (&Srem);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2702 defsubr (&Smod);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2703 defsubr (&Smax);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2704 defsubr (&Smin);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2705 defsubr (&Slogand);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2706 defsubr (&Slogior);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2707 defsubr (&Slogxor);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2708 defsubr (&Slsh);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2709 defsubr (&Sash);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2710 defsubr (&Sadd1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2711 defsubr (&Ssub1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2712 defsubr (&Slognot);
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
2713
9954
18b408b05189 (syms_of_data): Set Qwholenump as function, not variable.
Karl Heuer <kwzh@gnu.org>
parents: 9895
diff changeset
2714 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2715 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2716
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
2717 SIGTYPE
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2718 arith_error (signo)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2719 int signo;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2720 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2721 #ifdef USG
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2722 /* USG systems forget handlers when they are used;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2723 must reestablish each time */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2724 signal (signo, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2725 #endif /* USG */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726 #ifdef VMS
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2727 /* VMS systems are like USG. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2728 signal (signo, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2729 #endif /* VMS */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2730 #ifdef BSD4_1
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2731 sigrelse (SIGFPE);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2732 #else /* not BSD4_1 */
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
2733 sigsetmask (SIGEMPTYMASK);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 #endif /* not BSD4_1 */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736 Fsignal (Qarith_error, Qnil);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739 init_data ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741 /* Don't do this if just dumping out.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 We don't want to call `signal' in this case
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 so that we don't have trouble with dumping
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 signal-delivering routines in an inconsistent state. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2745 #ifndef CANNOT_DUMP
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2746 if (!initialized)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2747 return;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2748 #endif /* CANNOT_DUMP */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 signal (SIGFPE, arith_error);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2750
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2751 #ifdef uts
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2752 signal (SIGEMT, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 #endif /* uts */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2754 }