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