298
|
1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
|
64770
|
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
|
79759
|
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
|
|
4 Free Software Foundation, Inc.
|
298
|
5
|
|
6 This file is part of GNU Emacs.
|
|
7
|
94963
|
8 GNU Emacs is free software: you can redistribute it and/or modify
|
298
|
9 it under the terms of the GNU General Public License as published by
|
94963
|
10 the Free Software Foundation, either version 3 of the License, or
|
|
11 (at your option) any later version.
|
298
|
12
|
|
13 GNU Emacs is distributed in the hope that it will be useful,
|
|
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
16 GNU General Public License for more details.
|
|
17
|
|
18 You should have received a copy of the GNU General Public License
|
94963
|
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
298
|
20
|
|
21
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
22 #include <config.h>
|
298
|
23 #include <signal.h>
|
25780
|
24 #include <stdio.h>
|
298
|
25 #include "lisp.h"
|
336
|
26 #include "puresize.h"
|
88368
|
27 #include "character.h"
|
298
|
28 #include "buffer.h"
|
11341
|
29 #include "keyboard.h"
|
21144
|
30 #include "frame.h"
|
552
|
31 #include "syssignal.h"
|
83374
0b75ace4f7ad
Fix crash after y-or-n-p prompt triggered by emacsclient. (Reported by Han Boetes, analysis by Kalle Olavi Niemitalo.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
32 #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
|
348
|
33
|
2781
|
34 #ifdef STDC_HEADERS
|
20122
|
35 #include <float.h>
|
2781
|
36 #endif
|
4860
|
37
|
16787
|
38 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
|
|
39 #ifndef IEEE_FLOATING_POINT
|
|
40 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
|
|
41 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
|
|
42 #define IEEE_FLOATING_POINT 1
|
|
43 #else
|
|
44 #define IEEE_FLOATING_POINT 0
|
|
45 #endif
|
|
46 #endif
|
|
47
|
298
|
48 #include <math.h>
|
|
49
|
4780
|
50 #if !defined (atof)
|
|
51 extern double atof ();
|
|
52 #endif /* !atof */
|
|
53
|
298
|
54 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
|
|
55 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
|
|
56 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
|
648
|
57 Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
|
39767
|
58 Lisp_Object Qcyclic_variable_indirection, Qcircular_list;
|
298
|
59 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
|
|
60 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
|
4036
|
61 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
|
298
|
62 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
|
26274
|
63 Lisp_Object Qtext_read_only;
|
53110
|
64
|
6459
|
65 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
|
298
|
66 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
|
|
67 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
|
26931
|
68 Lisp_Object Qbuffer_or_string_p, Qkeywordp;
|
298
|
69 Lisp_Object Qboundp, Qfboundp;
|
13200
|
70 Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
|
10725
|
71
|
298
|
72 Lisp_Object Qcdr;
|
26205
|
73 Lisp_Object Qad_advice_info, Qad_activate_internal;
|
298
|
74
|
2092
|
75 Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
|
|
76 Lisp_Object Qoverflow_error, Qunderflow_error;
|
|
77
|
695
|
78 Lisp_Object Qfloatp;
|
298
|
79 Lisp_Object Qnumberp, Qnumber_or_marker_p;
|
|
80
|
53110
|
81 Lisp_Object Qinteger;
|
|
82 static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
|
17027
|
83 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
|
|
84 Lisp_Object Qprocess;
|
10725
|
85 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
|
26185
|
86 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
|
29237
|
87 static Lisp_Object Qsubrp, Qmany, Qunevalled;
|
10725
|
88
|
36819
|
89 static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
|
17830
|
90
|
41865
|
91 Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
|
39632
|
92
|
39767
|
93
|
|
94 void
|
|
95 circular_list_error (list)
|
|
96 Lisp_Object list;
|
|
97 {
|
71973
|
98 xsignal (Qcircular_list, list);
|
39767
|
99 }
|
|
100
|
|
101
|
298
|
102 Lisp_Object
|
|
103 wrong_type_argument (predicate, value)
|
|
104 register Lisp_Object predicate, value;
|
|
105 {
|
71830
|
106 /* If VALUE is not even a valid Lisp object, abort here
|
|
107 where we can get a backtrace showing where it came from. */
|
90970
|
108 if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
|
71830
|
109 abort ();
|
|
110
|
71973
|
111 xsignal2 (Qwrong_type_argument, predicate, value);
|
298
|
112 }
|
|
113
|
21514
|
114 void
|
298
|
115 pure_write_error ()
|
|
116 {
|
|
117 error ("Attempt to modify read-only object");
|
|
118 }
|
|
119
|
|
120 void
|
|
121 args_out_of_range (a1, a2)
|
|
122 Lisp_Object a1, a2;
|
|
123 {
|
71973
|
124 xsignal2 (Qargs_out_of_range, a1, a2);
|
298
|
125 }
|
|
126
|
|
127 void
|
|
128 args_out_of_range_3 (a1, a2, a3)
|
|
129 Lisp_Object a1, a2, a3;
|
|
130 {
|
71973
|
131 xsignal3 (Qargs_out_of_range, a1, a2, a3);
|
298
|
132 }
|
|
133
|
|
134 /* On some machines, XINT needs a temporary location.
|
|
135 Here it is, in case it is needed. */
|
|
136
|
|
137 int sign_extend_temp;
|
|
138
|
|
139 /* On a few machines, XINT can only be done by calling this. */
|
|
140
|
|
141 int
|
|
142 sign_extend_lisp_int (num)
|
8820
|
143 EMACS_INT num;
|
298
|
144 {
|
8820
|
145 if (num & (((EMACS_INT) 1) << (VALBITS - 1)))
|
|
146 return num | (((EMACS_INT) (-1)) << VALBITS);
|
298
|
147 else
|
8820
|
148 return num & ((((EMACS_INT) 1) << VALBITS) - 1);
|
298
|
149 }
|
|
150
|
|
151 /* Data type predicates */
|
|
152
|
|
153 DEFUN ("eq", Feq, Seq, 2, 2, 0,
|
40123
|
154 doc: /* Return t if the two args are the same Lisp object. */)
|
|
155 (obj1, obj2)
|
298
|
156 Lisp_Object obj1, obj2;
|
|
157 {
|
|
158 if (EQ (obj1, obj2))
|
|
159 return Qt;
|
|
160 return Qnil;
|
|
161 }
|
|
162
|
40123
|
163 DEFUN ("null", Fnull, Snull, 1, 1, 0,
|
|
164 doc: /* Return t if OBJECT is nil. */)
|
|
165 (object)
|
10725
|
166 Lisp_Object object;
|
298
|
167 {
|
10725
|
168 if (NILP (object))
|
298
|
169 return Qt;
|
|
170 return Qnil;
|
|
171 }
|
|
172
|
10725
|
173 DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
|
40123
|
174 doc: /* Return a symbol representing the type of OBJECT.
|
|
175 The symbol returned names the object's basic type;
|
|
176 for example, (type-of 1) returns `integer'. */)
|
|
177 (object)
|
10725
|
178 Lisp_Object object;
|
|
179 {
|
90970
|
180 switch (XTYPE (object))
|
10725
|
181 {
|
|
182 case Lisp_Int:
|
|
183 return Qinteger;
|
|
184
|
|
185 case Lisp_Symbol:
|
|
186 return Qsymbol;
|
|
187
|
|
188 case Lisp_String:
|
|
189 return Qstring;
|
|
190
|
|
191 case Lisp_Cons:
|
|
192 return Qcons;
|
|
193
|
|
194 case Lisp_Misc:
|
11239
|
195 switch (XMISCTYPE (object))
|
10725
|
196 {
|
|
197 case Lisp_Misc_Marker:
|
|
198 return Qmarker;
|
|
199 case Lisp_Misc_Overlay:
|
|
200 return Qoverlay;
|
|
201 case Lisp_Misc_Float:
|
|
202 return Qfloat;
|
|
203 }
|
|
204 abort ();
|
|
205
|
|
206 case Lisp_Vectorlike:
|
90970
|
207 if (WINDOW_CONFIGURATIONP (object))
|
10725
|
208 return Qwindow_configuration;
|
90970
|
209 if (PROCESSP (object))
|
10725
|
210 return Qprocess;
|
90970
|
211 if (WINDOWP (object))
|
10725
|
212 return Qwindow;
|
90970
|
213 if (SUBRP (object))
|
10725
|
214 return Qsubr;
|
90970
|
215 if (COMPILEDP (object))
|
10725
|
216 return Qcompiled_function;
|
90970
|
217 if (BUFFERP (object))
|
10725
|
218 return Qbuffer;
|
90970
|
219 if (CHAR_TABLE_P (object))
|
13715
|
220 return Qchar_table;
|
90970
|
221 if (BOOL_VECTOR_P (object))
|
13715
|
222 return Qbool_vector;
|
90970
|
223 if (FRAMEP (object))
|
10725
|
224 return Qframe;
|
90970
|
225 if (HASH_TABLE_P (object))
|
26185
|
226 return Qhash_table;
|
10725
|
227 return Qvector;
|
|
228
|
|
229 case Lisp_Float:
|
|
230 return Qfloat;
|
|
231
|
|
232 default:
|
|
233 abort ();
|
|
234 }
|
|
235 }
|
|
236
|
40123
|
237 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
|
|
238 doc: /* Return t if OBJECT is a cons cell. */)
|
|
239 (object)
|
10725
|
240 Lisp_Object object;
|
298
|
241 {
|
10725
|
242 if (CONSP (object))
|
298
|
243 return Qt;
|
|
244 return Qnil;
|
|
245 }
|
|
246
|
20617
|
247 DEFUN ("atom", Fatom, Satom, 1, 1, 0,
|
40123
|
248 doc: /* Return t if OBJECT is not a cons cell. This includes nil. */)
|
|
249 (object)
|
10725
|
250 Lisp_Object object;
|
298
|
251 {
|
10725
|
252 if (CONSP (object))
|
298
|
253 return Qnil;
|
|
254 return Qt;
|
|
255 }
|
|
256
|
20617
|
257 DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
|
68497
|
258 doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
|
|
259 Otherwise, return nil. */)
|
40123
|
260 (object)
|
10725
|
261 Lisp_Object object;
|
298
|
262 {
|
10725
|
263 if (CONSP (object) || NILP (object))
|
298
|
264 return Qt;
|
|
265 return Qnil;
|
|
266 }
|
|
267
|
20617
|
268 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
|
40123
|
269 doc: /* Return t if OBJECT is not a list. Lists include nil. */)
|
|
270 (object)
|
10725
|
271 Lisp_Object object;
|
298
|
272 {
|
10725
|
273 if (CONSP (object) || NILP (object))
|
298
|
274 return Qnil;
|
|
275 return Qt;
|
|
276 }
|
|
277
|
20617
|
278 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
|
40123
|
279 doc: /* Return t if OBJECT is a symbol. */)
|
|
280 (object)
|
10725
|
281 Lisp_Object object;
|
298
|
282 {
|
10725
|
283 if (SYMBOLP (object))
|
298
|
284 return Qt;
|
|
285 return Qnil;
|
|
286 }
|
|
287
|
26931
|
288 /* Define this in C to avoid unnecessarily consing up the symbol
|
|
289 name. */
|
|
290 DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
|
40123
|
291 doc: /* Return t if OBJECT is a keyword.
|
|
292 This means that it is a symbol with a print name beginning with `:'
|
|
293 interned in the initial obarray. */)
|
|
294 (object)
|
26931
|
295 Lisp_Object object;
|
|
296 {
|
|
297 if (SYMBOLP (object)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
298 && SREF (SYMBOL_NAME (object), 0) == ':'
|
39575
|
299 && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
|
26931
|
300 return Qt;
|
|
301 return Qnil;
|
|
302 }
|
|
303
|
20617
|
304 DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
|
40123
|
305 doc: /* Return t if OBJECT is a vector. */)
|
|
306 (object)
|
10725
|
307 Lisp_Object object;
|
298
|
308 {
|
10725
|
309 if (VECTORP (object))
|
298
|
310 return Qt;
|
|
311 return Qnil;
|
|
312 }
|
|
313
|
20617
|
314 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
|
40123
|
315 doc: /* Return t if OBJECT is a string. */)
|
|
316 (object)
|
10725
|
317 Lisp_Object object;
|
298
|
318 {
|
10725
|
319 if (STRINGP (object))
|
298
|
320 return Qt;
|
|
321 return Qnil;
|
|
322 }
|
|
323
|
20617
|
324 DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
|
40123
|
325 1, 1, 0,
|
|
326 doc: /* Return t if OBJECT is a multibyte string. */)
|
|
327 (object)
|
20617
|
328 Lisp_Object object;
|
|
329 {
|
|
330 if (STRINGP (object) && STRING_MULTIBYTE (object))
|
|
331 return Qt;
|
|
332 return Qnil;
|
|
333 }
|
|
334
|
|
335 DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0,
|
40123
|
336 doc: /* Return t if OBJECT is a char-table. */)
|
|
337 (object)
|
13148
|
338 Lisp_Object object;
|
|
339 {
|
|
340 if (CHAR_TABLE_P (object))
|
|
341 return Qt;
|
|
342 return Qnil;
|
|
343 }
|
|
344
|
13200
|
345 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
|
|
346 Svector_or_char_table_p, 1, 1, 0,
|
40123
|
347 doc: /* Return t if OBJECT is a char-table or vector. */)
|
|
348 (object)
|
13200
|
349 Lisp_Object object;
|
|
350 {
|
|
351 if (VECTORP (object) || CHAR_TABLE_P (object))
|
|
352 return Qt;
|
|
353 return Qnil;
|
|
354 }
|
|
355
|
40123
|
356 DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0,
|
|
357 doc: /* Return t if OBJECT is a bool-vector. */)
|
|
358 (object)
|
13148
|
359 Lisp_Object object;
|
|
360 {
|
|
361 if (BOOL_VECTOR_P (object))
|
|
362 return Qt;
|
|
363 return Qnil;
|
|
364 }
|
|
365
|
40123
|
366 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0,
|
|
367 doc: /* Return t if OBJECT is an array (string or vector). */)
|
|
368 (object)
|
10725
|
369 Lisp_Object object;
|
298
|
370 {
|
71830
|
371 if (ARRAYP (object))
|
298
|
372 return Qt;
|
|
373 return Qnil;
|
|
374 }
|
|
375
|
|
376 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
|
40123
|
377 doc: /* Return t if OBJECT is a sequence (list or array). */)
|
|
378 (object)
|
10725
|
379 register Lisp_Object object;
|
298
|
380 {
|
71830
|
381 if (CONSP (object) || NILP (object) || ARRAYP (object))
|
298
|
382 return Qt;
|
|
383 return Qnil;
|
|
384 }
|
|
385
|
40123
|
386 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0,
|
|
387 doc: /* Return t if OBJECT is an editor buffer. */)
|
|
388 (object)
|
10725
|
389 Lisp_Object object;
|
298
|
390 {
|
10725
|
391 if (BUFFERP (object))
|
298
|
392 return Qt;
|
|
393 return Qnil;
|
|
394 }
|
|
395
|
40123
|
396 DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
|
|
397 doc: /* Return t if OBJECT is a marker (editor pointer). */)
|
|
398 (object)
|
10725
|
399 Lisp_Object object;
|
298
|
400 {
|
10725
|
401 if (MARKERP (object))
|
298
|
402 return Qt;
|
|
403 return Qnil;
|
|
404 }
|
|
405
|
40123
|
406 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
|
|
407 doc: /* Return t if OBJECT is a built-in function. */)
|
|
408 (object)
|
10725
|
409 Lisp_Object object;
|
298
|
410 {
|
10725
|
411 if (SUBRP (object))
|
298
|
412 return Qt;
|
|
413 return Qnil;
|
|
414 }
|
|
415
|
1821
|
416 DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
|
40123
|
417 1, 1, 0,
|
|
418 doc: /* Return t if OBJECT is a byte-compiled function object. */)
|
|
419 (object)
|
10725
|
420 Lisp_Object object;
|
298
|
421 {
|
10725
|
422 if (COMPILEDP (object))
|
298
|
423 return Qt;
|
|
424 return Qnil;
|
|
425 }
|
|
426
|
6385
|
427 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
|
91019
|
428 doc: /* Return t if OBJECT is a character or a string. */)
|
40123
|
429 (object)
|
10725
|
430 register Lisp_Object object;
|
298
|
431 {
|
88623
|
432 if (CHARACTERP (object) || STRINGP (object))
|
298
|
433 return Qt;
|
|
434 return Qnil;
|
|
435 }
|
|
436
|
40123
|
437 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
|
|
438 doc: /* Return t if OBJECT is an integer. */)
|
|
439 (object)
|
10725
|
440 Lisp_Object object;
|
298
|
441 {
|
10725
|
442 if (INTEGERP (object))
|
298
|
443 return Qt;
|
|
444 return Qnil;
|
|
445 }
|
|
446
|
695
|
447 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
|
40123
|
448 doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */)
|
|
449 (object)
|
10725
|
450 register Lisp_Object object;
|
695
|
451 {
|
10725
|
452 if (MARKERP (object) || INTEGERP (object))
|
695
|
453 return Qt;
|
|
454 return Qnil;
|
|
455 }
|
|
456
|
6385
|
457 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
|
40123
|
458 doc: /* Return t if OBJECT is a nonnegative integer. */)
|
|
459 (object)
|
10725
|
460 Lisp_Object object;
|
298
|
461 {
|
10725
|
462 if (NATNUMP (object))
|
298
|
463 return Qt;
|
|
464 return Qnil;
|
|
465 }
|
|
466
|
695
|
467 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
|
40123
|
468 doc: /* Return t if OBJECT is a number (floating point or integer). */)
|
|
469 (object)
|
10725
|
470 Lisp_Object object;
|
695
|
471 {
|
10725
|
472 if (NUMBERP (object))
|
695
|
473 return Qt;
|
1821
|
474 else
|
|
475 return Qnil;
|
695
|
476 }
|
|
477
|
|
478 DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
|
|
479 Snumber_or_marker_p, 1, 1, 0,
|
40123
|
480 doc: /* Return t if OBJECT is a number or a marker. */)
|
|
481 (object)
|
10725
|
482 Lisp_Object object;
|
695
|
483 {
|
10725
|
484 if (NUMBERP (object) || MARKERP (object))
|
695
|
485 return Qt;
|
|
486 return Qnil;
|
|
487 }
|
|
488
|
298
|
489 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
|
40123
|
490 doc: /* Return t if OBJECT is a floating point number. */)
|
|
491 (object)
|
10725
|
492 Lisp_Object object;
|
298
|
493 {
|
10725
|
494 if (FLOATP (object))
|
298
|
495 return Qt;
|
|
496 return Qnil;
|
|
497 }
|
27727
|
498
|
298
|
499
|
|
500 /* Extract and set components of lists */
|
|
501
|
|
502 DEFUN ("car", Fcar, Scar, 1, 1, 0,
|
40123
|
503 doc: /* Return the car of LIST. If arg is nil, return nil.
|
68444
|
504 Error if arg is not nil and not a cons cell. See also `car-safe'.
|
|
505
|
68446
|
506 See Info node `(elisp)Cons Cells' for a discussion of related basic
|
|
507 Lisp concepts such as car, cdr, cons cell and list. */)
|
40123
|
508 (list)
|
298
|
509 register Lisp_Object list;
|
|
510 {
|
71830
|
511 return CAR (list);
|
298
|
512 }
|
|
513
|
|
514 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
|
40123
|
515 doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */)
|
|
516 (object)
|
298
|
517 Lisp_Object object;
|
|
518 {
|
71830
|
519 return CAR_SAFE (object);
|
298
|
520 }
|
|
521
|
|
522 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
|
40123
|
523 doc: /* Return the cdr of LIST. If arg is nil, return nil.
|
68444
|
524 Error if arg is not nil and not a cons cell. See also `cdr-safe'.
|
|
525
|
68446
|
526 See Info node `(elisp)Cons Cells' for a discussion of related basic
|
|
527 Lisp concepts such as cdr, car, cons cell and list. */)
|
40123
|
528 (list)
|
298
|
529 register Lisp_Object list;
|
|
530 {
|
71830
|
531 return CDR (list);
|
298
|
532 }
|
|
533
|
|
534 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
|
40123
|
535 doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */)
|
|
536 (object)
|
298
|
537 Lisp_Object object;
|
|
538 {
|
71830
|
539 return CDR_SAFE (object);
|
298
|
540 }
|
|
541
|
|
542 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
|
40123
|
543 doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */)
|
|
544 (cell, newcar)
|
298
|
545 register Lisp_Object cell, newcar;
|
|
546 {
|
71830
|
547 CHECK_CONS (cell);
|
298
|
548 CHECK_IMPURE (cell);
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
549 XSETCAR (cell, newcar);
|
298
|
550 return newcar;
|
|
551 }
|
|
552
|
|
553 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
|
40123
|
554 doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */)
|
|
555 (cell, newcdr)
|
298
|
556 register Lisp_Object cell, newcdr;
|
|
557 {
|
71830
|
558 CHECK_CONS (cell);
|
298
|
559 CHECK_IMPURE (cell);
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
560 XSETCDR (cell, newcdr);
|
298
|
561 return newcdr;
|
|
562 }
|
|
563
|
|
564 /* Extract and set components of symbols */
|
|
565
|
40123
|
566 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
|
|
567 doc: /* Return t if SYMBOL's value is not void. */)
|
|
568 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
569 register Lisp_Object symbol;
|
298
|
570 {
|
|
571 Lisp_Object valcontents;
|
40656
|
572 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
573
|
39575
|
574 valcontents = SYMBOL_VALUE (symbol);
|
298
|
575
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
576 if (BUFFER_LOCAL_VALUEP (valcontents))
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
577 valcontents = swap_in_symval_forwarding (symbol, valcontents);
|
298
|
578
|
9369
379c7b900689
(Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
579 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
|
298
|
580 }
|
|
581
|
40123
|
582 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
|
|
583 doc: /* Return t if SYMBOL's function definition is not void. */)
|
|
584 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
585 register Lisp_Object symbol;
|
298
|
586 {
|
40656
|
587 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
588 return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
|
298
|
589 }
|
|
590
|
40123
|
591 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
|
48961
|
592 doc: /* Make SYMBOL's value be void.
|
|
593 Return SYMBOL. */)
|
40123
|
594 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
595 register Lisp_Object symbol;
|
298
|
596 {
|
40656
|
597 CHECK_SYMBOL (symbol);
|
73838
|
598 if (SYMBOL_CONSTANT_P (symbol))
|
71973
|
599 xsignal1 (Qsetting_constant, symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
600 Fset (symbol, Qunbound);
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
601 return symbol;
|
298
|
602 }
|
|
603
|
40123
|
604 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
|
48961
|
605 doc: /* Make SYMBOL's function definition be void.
|
|
606 Return SYMBOL. */)
|
40123
|
607 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
608 register Lisp_Object symbol;
|
298
|
609 {
|
40656
|
610 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
611 if (NILP (symbol) || EQ (symbol, Qt))
|
71973
|
612 xsignal1 (Qsetting_constant, symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
613 XSYMBOL (symbol)->function = Qunbound;
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
614 return symbol;
|
298
|
615 }
|
|
616
|
|
617 DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
|
40123
|
618 doc: /* Return SYMBOL's function definition. Error if that is void. */)
|
|
619 (symbol)
|
648
|
620 register Lisp_Object symbol;
|
298
|
621 {
|
40656
|
622 CHECK_SYMBOL (symbol);
|
71973
|
623 if (!EQ (XSYMBOL (symbol)->function, Qunbound))
|
|
624 return XSYMBOL (symbol)->function;
|
|
625 xsignal1 (Qvoid_function, symbol);
|
298
|
626 }
|
|
627
|
40123
|
628 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
|
|
629 doc: /* Return SYMBOL's property list. */)
|
|
630 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
631 register Lisp_Object symbol;
|
298
|
632 {
|
40656
|
633 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
634 return XSYMBOL (symbol)->plist;
|
298
|
635 }
|
|
636
|
40123
|
637 DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
|
|
638 doc: /* Return SYMBOL's name, a string. */)
|
|
639 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
640 register Lisp_Object symbol;
|
298
|
641 {
|
|
642 register Lisp_Object name;
|
|
643
|
40656
|
644 CHECK_SYMBOL (symbol);
|
45397
|
645 name = SYMBOL_NAME (symbol);
|
298
|
646 return name;
|
|
647 }
|
|
648
|
|
649 DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
|
40123
|
650 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */)
|
|
651 (symbol, definition)
|
16754
|
652 register Lisp_Object symbol, definition;
|
298
|
653 {
|
79083
|
654 register Lisp_Object function;
|
|
655
|
40656
|
656 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
657 if (NILP (symbol) || EQ (symbol, Qt))
|
71973
|
658 xsignal1 (Qsetting_constant, symbol);
|
79083
|
659
|
|
660 function = XSYMBOL (symbol)->function;
|
|
661
|
|
662 if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
|
|
663 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
|
|
664
|
|
665 if (CONSP (function) && EQ (XCAR (function), Qautoload))
|
|
666 Fput (symbol, Qautoload, XCDR (function));
|
|
667
|
16754
|
668 XSYMBOL (symbol)->function = definition;
|
8401
|
669 /* Handle automatic advice activation */
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
670 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
|
8401
|
671 {
|
26205
|
672 call2 (Qad_activate_internal, symbol, Qnil);
|
16754
|
673 definition = XSYMBOL (symbol)->function;
|
8401
|
674 }
|
16754
|
675 return definition;
|
298
|
676 }
|
|
677
|
46279
|
678 extern Lisp_Object Qfunction_documentation;
|
|
679
|
|
680 DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
|
40123
|
681 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
|
46521
|
682 Associates the function with the current load file, if any.
|
|
683 The optional third argument DOCSTRING specifies the documentation string
|
|
684 for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
|
|
685 determined by DEFINITION. */)
|
46279
|
686 (symbol, definition, docstring)
|
|
687 register Lisp_Object symbol, definition, docstring;
|
2548
|
688 {
|
65600
|
689 CHECK_SYMBOL (symbol);
|
48723
|
690 if (CONSP (XSYMBOL (symbol)->function)
|
|
691 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
|
|
692 LOADHIST_ATTACH (Fcons (Qt, symbol));
|
25132
|
693 definition = Ffset (symbol, definition);
|
59110
|
694 LOADHIST_ATTACH (Fcons (Qdefun, symbol));
|
46279
|
695 if (!NILP (docstring))
|
|
696 Fput (symbol, Qfunction_documentation, docstring);
|
16756
|
697 return definition;
|
2548
|
698 }
|
|
699
|
298
|
700 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
|
52938
|
701 doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */)
|
40123
|
702 (symbol, newplist)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
703 register Lisp_Object symbol, newplist;
|
298
|
704 {
|
40656
|
705 CHECK_SYMBOL (symbol);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
706 XSYMBOL (symbol)->plist = newplist;
|
298
|
707 return newplist;
|
|
708 }
|
648
|
709
|
29237
|
710 DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
|
40123
|
711 doc: /* Return minimum and maximum number of args allowed for SUBR.
|
|
712 SUBR must be a built-in function.
|
|
713 The returned value is a pair (MIN . MAX). MIN is the minimum number
|
|
714 of args. MAX is the maximum number or the symbol `many', for a
|
|
715 function with `&rest' args, or `unevalled' for a special form. */)
|
|
716 (subr)
|
29237
|
717 Lisp_Object subr;
|
|
718 {
|
|
719 short minargs, maxargs;
|
71830
|
720 CHECK_SUBR (subr);
|
29237
|
721 minargs = XSUBR (subr)->min_args;
|
|
722 maxargs = XSUBR (subr)->max_args;
|
|
723 if (maxargs == MANY)
|
|
724 return Fcons (make_number (minargs), Qmany);
|
|
725 else if (maxargs == UNEVALLED)
|
|
726 return Fcons (make_number (minargs), Qunevalled);
|
|
727 else
|
|
728 return Fcons (make_number (minargs), make_number (maxargs));
|
|
729 }
|
|
730
|
55230
|
731 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
|
|
732 doc: /* Return name of subroutine SUBR.
|
|
733 SUBR must be a built-in function. */)
|
|
734 (subr)
|
|
735 Lisp_Object subr;
|
|
736 {
|
|
737 const char *name;
|
71830
|
738 CHECK_SUBR (subr);
|
55230
|
739 name = XSUBR (subr)->symbol_name;
|
|
740 return make_string (name, strlen (name));
|
|
741 }
|
|
742
|
54627
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
743 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
744 doc: /* Return the interactive form of CMD or nil if none.
|
56590
|
745 If CMD is not a command, the return value is nil.
|
|
746 Value, if non-nil, is a list \(interactive SPEC). */)
|
54627
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
747 (cmd)
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
748 Lisp_Object cmd;
|
37053
|
749 {
|
82112
|
750 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
|
85292
|
751
|
82112
|
752 if (NILP (fun) || EQ (fun, Qunbound))
|
|
753 return Qnil;
|
|
754
|
|
755 /* Use an `interactive-form' property if present, analogous to the
|
|
756 function-documentation property. */
|
|
757 fun = cmd;
|
|
758 while (SYMBOLP (fun))
|
|
759 {
|
|
760 Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
|
|
761 if (!NILP (tmp))
|
|
762 return tmp;
|
|
763 else
|
|
764 fun = Fsymbol_function (fun);
|
|
765 }
|
54627
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
766
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
767 if (SUBRP (fun))
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
768 {
|
84438
48251c264d8d
(Finteractive_form): If the interactive specification starts with a `(',
Michaël Cadilhac <michael.cadilhac@lrde.org>
diff
changeset
|
769 char *spec = XSUBR (fun)->intspec;
|
48251c264d8d
(Finteractive_form): If the interactive specification starts with a `(',
Michaël Cadilhac <michael.cadilhac@lrde.org>
diff
changeset
|
770 if (spec)
|
48251c264d8d
(Finteractive_form): If the interactive specification starts with a `(',
Michaël Cadilhac <michael.cadilhac@lrde.org>
diff
changeset
|
771 return list2 (Qinteractive,
|
48251c264d8d
(Finteractive_form): If the interactive specification starts with a `(',
Michaël Cadilhac <michael.cadilhac@lrde.org>
diff
changeset
|
772 (*spec != '(') ? build_string (spec) :
|
48251c264d8d
(Finteractive_form): If the interactive specification starts with a `(',
Michaël Cadilhac <michael.cadilhac@lrde.org>
diff
changeset
|
773 Fcar (Fread_from_string (build_string (spec), Qnil, Qnil)));
|
54627
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
774 }
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
775 else if (COMPILEDP (fun))
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
776 {
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
777 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
778 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
779 }
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
780 else if (CONSP (fun))
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
781 {
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
782 Lisp_Object funcar = XCAR (fun);
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
783 if (EQ (funcar, Qlambda))
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
784 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
785 else if (EQ (funcar, Qautoload))
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
786 {
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
787 struct gcpro gcpro1;
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
788 GCPRO1 (cmd);
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
789 do_autoload (fun, cmd);
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
790 UNGCPRO;
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
791 return Finteractive_form (cmd);
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
792 }
|
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
793 }
|
37053
|
794 return Qnil;
|
|
795 }
|
|
796
|
298
|
797
|
39575
|
798 /***********************************************************************
|
|
799 Getting and Setting Values of Symbols
|
|
800 ***********************************************************************/
|
|
801
|
|
802 /* Return the symbol holding SYMBOL's value. Signal
|
|
803 `cyclic-variable-indirection' if SYMBOL's chain of variable
|
|
804 indirections contains a loop. */
|
|
805
|
95112
|
806 struct Lisp_Symbol *
|
39575
|
807 indirect_variable (symbol)
|
95112
|
808 struct Lisp_Symbol *symbol;
|
39575
|
809 {
|
95112
|
810 struct Lisp_Symbol *tortoise, *hare;
|
39575
|
811
|
|
812 hare = tortoise = symbol;
|
|
813
|
95112
|
814 while (hare->indirect_variable)
|
39575
|
815 {
|
95112
|
816 hare = XSYMBOL (hare->value);
|
|
817 if (!hare->indirect_variable)
|
39575
|
818 break;
|
48961
|
819
|
95112
|
820 hare = XSYMBOL (hare->value);
|
|
821 tortoise = XSYMBOL (tortoise->value);
|
|
822
|
|
823 if (hare == tortoise)
|
|
824 {
|
|
825 Lisp_Object tem;
|
|
826 XSETSYMBOL (tem, symbol);
|
|
827 xsignal1 (Qcyclic_variable_indirection, tem);
|
|
828 }
|
39575
|
829 }
|
|
830
|
|
831 return hare;
|
|
832 }
|
|
833
|
|
834
|
|
835 DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
|
40123
|
836 doc: /* Return the variable at the end of OBJECT's variable chain.
|
|
837 If OBJECT is a symbol, follow all variable indirections and return the final
|
|
838 variable. If OBJECT is not a symbol, just return it.
|
|
839 Signal a cyclic-variable-indirection error if there is a loop in the
|
|
840 variable chain of symbols. */)
|
|
841 (object)
|
39575
|
842 Lisp_Object object;
|
|
843 {
|
|
844 if (SYMBOLP (object))
|
95112
|
845 XSETSYMBOL (object, indirect_variable (XSYMBOL (object)));
|
39575
|
846 return object;
|
|
847 }
|
|
848
|
298
|
849
|
|
850 /* Given the raw contents of a symbol value cell,
|
|
851 return the Lisp value of the symbol.
|
|
852 This does not handle buffer-local variables; use
|
|
853 swap_in_symval_forwarding for that. */
|
|
854
|
|
855 Lisp_Object
|
|
856 do_symval_forwarding (valcontents)
|
|
857 register Lisp_Object valcontents;
|
|
858 {
|
|
859 register Lisp_Object val;
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
860 if (MISCP (valcontents))
|
11239
|
861 switch (XMISCTYPE (valcontents))
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
862 {
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
863 case Lisp_Misc_Intfwd:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
864 XSETINT (val, *XINTFWD (valcontents)->intvar);
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
865 return val;
|
298
|
866
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
867 case Lisp_Misc_Boolfwd:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
868 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
|
298
|
869
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
870 case Lisp_Misc_Objfwd:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
871 return *XOBJFWD (valcontents)->objvar;
|
298
|
872
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
873 case Lisp_Misc_Buffer_Objfwd:
|
86348
4505355014c0
(do_symval_forwarding): Use same code as in find_symbol_value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
874 return PER_BUFFER_VALUE (current_buffer,
|
4505355014c0
(do_symval_forwarding): Use same code as in find_symbol_value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
875 XBUFFER_OBJFWD (valcontents)->offset);
|
10605
|
876
|
11019
|
877 case Lisp_Misc_Kboard_Objfwd:
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
878 /* We used to simply use current_kboard here, but from Lisp
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
879 code, it's value is often unexpected. It seems nicer to
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
880 allow constructions like this to work as intuitively expected:
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
881
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
882 (with-selected-frame frame
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
883 (define-key local-function-map "\eOP" [f1]))
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
884
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
885 On the other hand, this affects the semantics of
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
886 last-command and real-last-command, and people may rely on
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
887 that. I took a quick look at the Lisp codebase, and I
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
888 don't think anything will break. --lorentey */
|
86348
4505355014c0
(do_symval_forwarding): Use same code as in find_symbol_value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
889 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
|
4505355014c0
(do_symval_forwarding): Use same code as in find_symbol_value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
890 + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
891 }
|
298
|
892 return valcontents;
|
|
893 }
|
|
894
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
895 /* 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
|
896 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
|
298
|
897 buffer-independent contents of the value cell: forwarded just one
|
36819
|
898 step past the buffer-localness.
|
|
899
|
|
900 BUF non-zero means set the value in buffer BUF instead of the
|
|
901 current buffer. This only plays a role for per-buffer variables. */
|
298
|
902
|
|
903 void
|
36819
|
904 store_symval_forwarding (symbol, valcontents, newval, buf)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
905 Lisp_Object symbol;
|
298
|
906 register Lisp_Object valcontents, newval;
|
36819
|
907 struct buffer *buf;
|
298
|
908 {
|
10457
2ab3bd0288a9
Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
909 switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
|
298
|
910 {
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
911 case Lisp_Misc:
|
11239
|
912 switch (XMISCTYPE (valcontents))
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
913 {
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
914 case Lisp_Misc_Intfwd:
|
40656
|
915 CHECK_NUMBER (newval);
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
916 *XINTFWD (valcontents)->intvar = XINT (newval);
|
86229
|
917 /* This can never happen since intvar points to an EMACS_INT
|
|
918 which is at least large enough to hold a Lisp_Object.
|
|
919 if (*XINTFWD (valcontents)->intvar != XINT (newval))
|
|
920 error ("Value out of range for variable `%s'",
|
|
921 SDATA (SYMBOL_NAME (symbol))); */
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
922 break;
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
923
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
924 case Lisp_Misc_Boolfwd:
|
86285
59344cb482f3
* lisp.h (struct Lisp_Buffer_Objfwd): Add a `slottype' field.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
925 *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
926 break;
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
927
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
928 case Lisp_Misc_Objfwd:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
929 *XOBJFWD (valcontents)->objvar = newval;
|
53365
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
930
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
931 /* If this variable is a default for something stored
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
932 in the buffer itself, such as default-fill-column,
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
933 find the buffers that don't have local values for it
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
934 and update them. */
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
935 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
936 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
937 {
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
938 int offset = ((char *) XOBJFWD (valcontents)->objvar
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
939 - (char *) &buffer_defaults);
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
940 int idx = PER_BUFFER_IDX (offset);
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
941
|
58086
|
942 Lisp_Object tail;
|
53365
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
943
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
944 if (idx <= 0)
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
945 break;
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
946
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
947 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
948 {
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
949 Lisp_Object buf;
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
950 struct buffer *b;
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
951
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
952 buf = Fcdr (XCAR (tail));
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
953 if (!BUFFERP (buf)) continue;
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
954 b = XBUFFER (buf);
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
955
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
956 if (! PER_BUFFER_VALUE_P (b, idx))
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
957 PER_BUFFER_VALUE (b, offset) = newval;
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
958 }
|
3ca4a81861a1
(store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
959 }
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
960 break;
|
298
|
961
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
962 case Lisp_Misc_Buffer_Objfwd:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
963 {
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
964 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
86285
59344cb482f3
* lisp.h (struct Lisp_Buffer_Objfwd): Add a `slottype' field.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
965 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
|
59344cb482f3
* lisp.h (struct Lisp_Buffer_Objfwd): Add a `slottype' field.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
966
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
967 if (! NILP (type) && ! NILP (newval)
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
968 && XTYPE (newval) != XINT (type))
|
95112
|
969 buffer_slot_type_mismatch (newval, XINT (type));
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
970
|
36819
|
971 if (buf == NULL)
|
|
972 buf = current_buffer;
|
|
973 PER_BUFFER_VALUE (buf, offset) = newval;
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
974 }
|
10605
|
975 break;
|
|
976
|
11019
|
977 case Lisp_Misc_Kboard_Objfwd:
|
36819
|
978 {
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
979 char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
|
36819
|
980 char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
|
|
981 *(Lisp_Object *) p = newval;
|
|
982 }
|
10605
|
983 break;
|
|
984
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
985 default:
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
986 goto def;
|
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
987 }
|
298
|
988 break;
|
|
989
|
|
990 default:
|
9465
ea2ee8bd3c63
(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
991 def:
|
39575
|
992 valcontents = SYMBOL_VALUE (symbol);
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
993 if (BUFFER_LOCAL_VALUEP (valcontents))
|
21144
|
994 XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
|
298
|
995 else
|
39575
|
996 SET_SYMBOL_VALUE (symbol, newval);
|
298
|
997 }
|
|
998 }
|
|
999
|
29618
|
1000 /* Set up SYMBOL to refer to its global binding.
|
|
1001 This makes it safe to alter the status of other bindings. */
|
|
1002
|
|
1003 void
|
|
1004 swap_in_global_binding (symbol)
|
|
1005 Lisp_Object symbol;
|
|
1006 {
|
86082
|
1007 Lisp_Object valcontents = SYMBOL_VALUE (symbol);
|
|
1008 struct Lisp_Buffer_Local_Value *blv = XBUFFER_LOCAL_VALUE (valcontents);
|
|
1009 Lisp_Object cdr = blv->cdr;
|
29618
|
1010
|
|
1011 /* Unload the previously loaded binding. */
|
|
1012 Fsetcdr (XCAR (cdr),
|
86082
|
1013 do_symval_forwarding (blv->realvalue));
|
48961
|
1014
|
29618
|
1015 /* Select the global binding in the symbol. */
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1016 XSETCAR (cdr, cdr);
|
86082
|
1017 store_symval_forwarding (symbol, blv->realvalue, XCDR (cdr), NULL);
|
29618
|
1018
|
|
1019 /* Indicate that the global binding is set up now. */
|
86082
|
1020 blv->frame = Qnil;
|
|
1021 blv->buffer = Qnil;
|
|
1022 blv->found_for_frame = 0;
|
|
1023 blv->found_for_buffer = 0;
|
29618
|
1024 }
|
|
1025
|
27294
|
1026 /* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
|
27778
|
1027 VALCONTENTS is the contents of its value cell,
|
|
1028 which points to a struct Lisp_Buffer_Local_Value.
|
|
1029
|
|
1030 Return the value forwarded one step past the buffer-local stage.
|
|
1031 This could be another forwarding pointer. */
|
298
|
1032
|
|
1033 static Lisp_Object
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1034 swap_in_symval_forwarding (symbol, valcontents)
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1035 Lisp_Object symbol, valcontents;
|
298
|
1036 {
|
|
1037 register Lisp_Object tem1;
|
48961
|
1038
|
21144
|
1039 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
|
|
1040
|
27778
|
1041 if (NILP (tem1)
|
|
1042 || current_buffer != XBUFFER (tem1)
|
|
1043 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
|
|
1044 && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)))
|
298
|
1045 {
|
95112
|
1046 struct Lisp_Symbol *sym = XSYMBOL (symbol);
|
|
1047 if (sym->indirect_variable)
|
|
1048 {
|
|
1049 sym = indirect_variable (sym);
|
|
1050 XSETSYMBOL (symbol, sym);
|
|
1051 }
|
48961
|
1052
|
27778
|
1053 /* Unload the previously loaded binding. */
|
26164
|
1054 tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1055 Fsetcdr (tem1,
|
21144
|
1056 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
|
27778
|
1057 /* Choose the new binding. */
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1058 tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
|
21144
|
1059 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
|
|
1060 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
|
490
|
1061 if (NILP (tem1))
|
21144
|
1062 {
|
|
1063 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
|
25665
|
1064 tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist);
|
21144
|
1065 if (! NILP (tem1))
|
|
1066 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
|
|
1067 else
|
|
1068 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
|
|
1069 }
|
|
1070 else
|
|
1071 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
|
|
1072
|
27778
|
1073 /* Load the new binding. */
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1074 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
|
21144
|
1075 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer);
|
25665
|
1076 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
|
21144
|
1077 store_symval_forwarding (symbol,
|
|
1078 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
|
36819
|
1079 Fcdr (tem1), NULL);
|
298
|
1080 }
|
21144
|
1081 return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
|
298
|
1082 }
|
|
1083
|
514
|
1084 /* Find the value of a symbol, returning Qunbound if it's not bound.
|
|
1085 This is helpful for code which just wants to get a variable's value
|
14036
|
1086 if it has one, without signaling an error.
|
514
|
1087 Note that it must not be possible to quit
|
|
1088 within this function. Great care is required for this. */
|
298
|
1089
|
514
|
1090 Lisp_Object
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1091 find_symbol_value (symbol)
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1092 Lisp_Object symbol;
|
298
|
1093 {
|
25780
|
1094 register Lisp_Object valcontents;
|
298
|
1095 register Lisp_Object val;
|
48961
|
1096
|
40656
|
1097 CHECK_SYMBOL (symbol);
|
39575
|
1098 valcontents = SYMBOL_VALUE (symbol);
|
298
|
1099
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1100 if (BUFFER_LOCAL_VALUEP (valcontents))
|
34964
|
1101 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
|
1102
|
86348
4505355014c0
(do_symval_forwarding): Use same code as in find_symbol_value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1103 return do_symval_forwarding (valcontents);
|
298
|
1104 }
|
|
1105
|
514
|
1106 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
|
40123
|
1107 doc: /* Return SYMBOL's value. Error if that is void. */)
|
|
1108 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1109 Lisp_Object symbol;
|
514
|
1110 {
|
6497
89ff61b53cee
(store_symval_forwarding, Fsymbol_value): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1111 Lisp_Object val;
|
514
|
1112
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1113 val = find_symbol_value (symbol);
|
71973
|
1114 if (!EQ (val, Qunbound))
|
514
|
1115 return val;
|
71973
|
1116
|
|
1117 xsignal1 (Qvoid_variable, symbol);
|
514
|
1118 }
|
|
1119
|
298
|
1120 DEFUN ("set", Fset, Sset, 2, 2, 0,
|
40123
|
1121 doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */)
|
|
1122 (symbol, newval)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1123 register Lisp_Object symbol, newval;
|
298
|
1124 {
|
27294
|
1125 return set_internal (symbol, newval, current_buffer, 0);
|
16931
|
1126 }
|
|
1127
|
27703
|
1128 /* Return 1 if SYMBOL currently has a let-binding
|
|
1129 which was made in the buffer that is now current. */
|
|
1130
|
|
1131 static int
|
|
1132 let_shadows_buffer_binding_p (symbol)
|
95112
|
1133 struct Lisp_Symbol *symbol;
|
27703
|
1134 {
|
51030
|
1135 volatile struct specbinding *p;
|
27703
|
1136
|
|
1137 for (p = specpdl_ptr - 1; p >= specpdl; p--)
|
39575
|
1138 if (p->func == NULL
|
|
1139 && CONSP (p->symbol))
|
|
1140 {
|
95112
|
1141 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
|
|
1142 if ((symbol == let_bound_symbol
|
|
1143 || (let_bound_symbol->indirect_variable
|
|
1144 && symbol == indirect_variable (let_bound_symbol)))
|
39575
|
1145 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
|
|
1146 break;
|
|
1147 }
|
|
1148
|
|
1149 return p >= specpdl;
|
27703
|
1150 }
|
|
1151
|
20617
|
1152 /* Store the value NEWVAL into SYMBOL.
|
27294
|
1153 If buffer-locality is an issue, BUF specifies which buffer to use.
|
|
1154 (0 stands for the current buffer.)
|
|
1155
|
16931
|
1156 If BINDFLAG is zero, then if this symbol is supposed to become
|
|
1157 local in every buffer where it is set, then we make it local.
|
|
1158 If BINDFLAG is nonzero, we don't do that. */
|
|
1159
|
|
1160 Lisp_Object
|
27294
|
1161 set_internal (symbol, newval, buf, bindflag)
|
16931
|
1162 register Lisp_Object symbol, newval;
|
27294
|
1163 struct buffer *buf;
|
16931
|
1164 int bindflag;
|
|
1165 {
|
9369
379c7b900689
(Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1166 int voide = EQ (newval, Qunbound);
|
298
|
1167
|
29735
|
1168 register Lisp_Object valcontents, innercontents, tem1, current_alist_element;
|
298
|
1169
|
27294
|
1170 if (buf == 0)
|
|
1171 buf = current_buffer;
|
|
1172
|
|
1173 /* If restoring in a dead buffer, do nothing. */
|
|
1174 if (NILP (buf->name))
|
|
1175 return newval;
|
|
1176
|
40656
|
1177 CHECK_SYMBOL (symbol);
|
39575
|
1178 if (SYMBOL_CONSTANT_P (symbol)
|
|
1179 && (NILP (Fkeywordp (symbol))
|
|
1180 || !EQ (newval, SYMBOL_VALUE (symbol))))
|
71973
|
1181 xsignal1 (Qsetting_constant, symbol);
|
29735
|
1182
|
39575
|
1183 innercontents = valcontents = SYMBOL_VALUE (symbol);
|
48961
|
1184
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1185 if (BUFFER_OBJFWDP (valcontents))
|
298
|
1186 {
|
28312
|
1187 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
28351
|
1188 int idx = PER_BUFFER_IDX (offset);
|
28312
|
1189 if (idx > 0
|
|
1190 && !bindflag
|
95589
4f530a89d1ee
(set_internal): Fix up call to let_shadows_buffer_binding_p.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1191 && !let_shadows_buffer_binding_p (XSYMBOL (symbol)))
|
28351
|
1192 SET_PER_BUFFER_VALUE_P (buf, idx, 1);
|
298
|
1193 }
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1194 else if (BUFFER_LOCAL_VALUEP (valcontents))
|
298
|
1195 {
|
27778
|
1196 /* valcontents is a struct Lisp_Buffer_Local_Value. */
|
39575
|
1197 if (XSYMBOL (symbol)->indirect_variable)
|
95112
|
1198 XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol)));
|
27778
|
1199
|
|
1200 /* What binding is loaded right now? */
|
21144
|
1201 current_alist_element
|
26164
|
1202 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
|
298
|
1203
|
733
|
1204 /* If the current buffer is not the buffer whose binding is
|
27778
|
1205 loaded, or if there may be frame-local bindings and the frame
|
|
1206 isn't the right one, or if it's a Lisp_Buffer_Local_Value and
|
|
1207 the default binding is loaded, the loaded binding may be the
|
|
1208 wrong one. */
|
28417
4b675266db04
* lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1209 if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
|
4b675266db04
* lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1210 || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
|
27778
|
1211 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
|
|
1212 && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))
|
86338
|
1213 /* Also unload a global binding (if the var is local_if_set). */
|
86229
|
1214 || (EQ (XCAR (current_alist_element),
|
|
1215 current_alist_element)))
|
298
|
1216 {
|
27778
|
1217 /* The currently loaded binding is not necessarily valid.
|
|
1218 We need to unload it, and choose a new binding. */
|
|
1219
|
|
1220 /* Write out `realvalue' to the old loaded binding. */
|
733
|
1221 Fsetcdr (current_alist_element,
|
21144
|
1222 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
|
298
|
1223
|
27778
|
1224 /* Find the new binding. */
|
27294
|
1225 tem1 = Fassq (symbol, buf->local_var_alist);
|
21144
|
1226 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
|
|
1227 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
|
|
1228
|
490
|
1229 if (NILP (tem1))
|
733
|
1230 {
|
|
1231 /* This buffer still sees the default value. */
|
|
1232
|
86338
|
1233 /* If the variable is not local_if_set,
|
16931
|
1234 or if this is `let' rather than `set',
|
733
|
1235 make CURRENT-ALIST-ELEMENT point to itself,
|
27703
|
1236 indicating that we're seeing the default value.
|
|
1237 Likewise if the variable has been let-bound
|
|
1238 in the current buffer. */
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1239 if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set
|
95112
|
1240 || let_shadows_buffer_binding_p (XSYMBOL (symbol)))
|
21144
|
1241 {
|
|
1242 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
|
|
1243
|
|
1244 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
|
25665
|
1245 tem1 = Fassq (symbol,
|
|
1246 XFRAME (selected_frame)->param_alist);
|
21144
|
1247
|
|
1248 if (! NILP (tem1))
|
|
1249 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
|
|
1250 else
|
|
1251 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
|
|
1252 }
|
16931
|
1253 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
|
27703
|
1254 and we're not within a let that was made for this buffer,
|
|
1255 create a new buffer-local binding for the variable.
|
|
1256 That means, give this buffer a new assoc for a local value
|
27778
|
1257 and load that binding. */
|
733
|
1258 else
|
|
1259 {
|
46279
|
1260 tem1 = Fcons (symbol, XCDR (current_alist_element));
|
27294
|
1261 buf->local_var_alist
|
|
1262 = Fcons (tem1, buf->local_var_alist);
|
733
|
1263 }
|
|
1264 }
|
21144
|
1265
|
27778
|
1266 /* Record which binding is now loaded. */
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1267 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
|
733
|
1268
|
74706
|
1269 /* Set `buffer' and `frame' slots for the binding now loaded. */
|
27294
|
1270 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf);
|
25665
|
1271 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
|
298
|
1272 }
|
29735
|
1273 innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
|
86338
|
1274
|
|
1275 /* Store the new value in the cons-cell. */
|
|
1276 XSETCDR (XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr), newval);
|
298
|
1277 }
|
733
|
1278
|
298
|
1279 /* If storing void (making the symbol void), forward only through
|
|
1280 buffer-local indicator, not through Lisp_Objfwd, etc. */
|
|
1281 if (voide)
|
36819
|
1282 store_symval_forwarding (symbol, Qnil, newval, buf);
|
298
|
1283 else
|
36819
|
1284 store_symval_forwarding (symbol, innercontents, newval, buf);
|
29735
|
1285
|
298
|
1286 return newval;
|
|
1287 }
|
|
1288
|
|
1289 /* Access or set a buffer-local symbol's default value. */
|
|
1290
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1291 /* 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
|
1292 Return Qunbound if it is void. */
|
298
|
1293
|
|
1294 Lisp_Object
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1295 default_value (symbol)
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1296 Lisp_Object symbol;
|
298
|
1297 {
|
|
1298 register Lisp_Object valcontents;
|
|
1299
|
40656
|
1300 CHECK_SYMBOL (symbol);
|
39575
|
1301 valcontents = SYMBOL_VALUE (symbol);
|
298
|
1302
|
|
1303 /* For a built-in buffer-local variable, get the default value
|
|
1304 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
|
1305 if (BUFFER_OBJFWDP (valcontents))
|
298
|
1306 {
|
28312
|
1307 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
28351
|
1308 if (PER_BUFFER_IDX (offset) != 0)
|
|
1309 return PER_BUFFER_DEFAULT (offset);
|
298
|
1310 }
|
|
1311
|
|
1312 /* Handle user-created local variables. */
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1313 if (BUFFER_LOCAL_VALUEP (valcontents))
|
298
|
1314 {
|
|
1315 /* If var is set up for a buffer that lacks a local value for it,
|
|
1316 the current value is nominally the default value.
|
27778
|
1317 But the `realvalue' slot may be more up to date, since
|
298
|
1318 ordinary setq stores just that slot. So use that. */
|
|
1319 Lisp_Object current_alist_element, alist_element_car;
|
|
1320 current_alist_element
|
26164
|
1321 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
|
|
1322 alist_element_car = XCAR (current_alist_element);
|
298
|
1323 if (EQ (alist_element_car, current_alist_element))
|
21144
|
1324 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue);
|
298
|
1325 else
|
26164
|
1326 return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
|
298
|
1327 }
|
|
1328 /* For other variables, get the current value. */
|
|
1329 return do_symval_forwarding (valcontents);
|
|
1330 }
|
|
1331
|
|
1332 DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
|
40123
|
1333 doc: /* Return t if SYMBOL has a non-void default value.
|
|
1334 This is the value that is seen in buffers that do not have their own values
|
|
1335 for this variable. */)
|
|
1336 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1337 Lisp_Object symbol;
|
298
|
1338 {
|
|
1339 register Lisp_Object value;
|
|
1340
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1341 value = default_value (symbol);
|
9369
379c7b900689
(Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1342 return (EQ (value, Qunbound) ? Qnil : Qt);
|
298
|
1343 }
|
|
1344
|
|
1345 DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
|
40123
|
1346 doc: /* Return SYMBOL's default value.
|
|
1347 This is the value that is seen in buffers that do not have their own values
|
|
1348 for this variable. The default value is meaningful for variables with
|
|
1349 local bindings in certain buffers. */)
|
|
1350 (symbol)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1351 Lisp_Object symbol;
|
298
|
1352 {
|
|
1353 register Lisp_Object value;
|
|
1354
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1355 value = default_value (symbol);
|
71973
|
1356 if (!EQ (value, Qunbound))
|
|
1357 return value;
|
|
1358
|
|
1359 xsignal1 (Qvoid_variable, symbol);
|
298
|
1360 }
|
|
1361
|
|
1362 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
|
55616
c2be5da8c8cb
(Fset_default): Make argument names match their use in docstring.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1363 doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
|
40123
|
1364 The default value is seen in buffers that do not have their own values
|
|
1365 for this variable. */)
|
|
1366 (symbol, value)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1367 Lisp_Object symbol, value;
|
298
|
1368 {
|
|
1369 register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
|
|
1370
|
40656
|
1371 CHECK_SYMBOL (symbol);
|
39575
|
1372 valcontents = SYMBOL_VALUE (symbol);
|
298
|
1373
|
|
1374 /* Handle variables like case-fold-search that have special slots
|
|
1375 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
|
|
1376 variables. */
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1377 if (BUFFER_OBJFWDP (valcontents))
|
298
|
1378 {
|
28312
|
1379 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
28351
|
1380 int idx = PER_BUFFER_IDX (offset);
|
|
1381
|
|
1382 PER_BUFFER_DEFAULT (offset) = value;
|
20996
|
1383
|
|
1384 /* If this variable is not always local in all buffers,
|
|
1385 set it in the buffers that don't nominally have a local value. */
|
28312
|
1386 if (idx > 0)
|
298
|
1387 {
|
28312
|
1388 struct buffer *b;
|
48961
|
1389
|
298
|
1390 for (b = all_buffers; b; b = b->next)
|
28351
|
1391 if (!PER_BUFFER_VALUE_P (b, idx))
|
|
1392 PER_BUFFER_VALUE (b, offset) = value;
|
298
|
1393 }
|
|
1394 return value;
|
|
1395 }
|
|
1396
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1397 if (!BUFFER_LOCAL_VALUEP (valcontents))
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1398 return Fset (symbol, value);
|
298
|
1399
|
27778
|
1400 /* Store new value into the DEFAULT-VALUE slot. */
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1401 XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value);
|
298
|
1402
|
27778
|
1403 /* If the default binding is now loaded, set the REALVALUE slot too. */
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1404 current_alist_element
|
26164
|
1405 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
|
298
|
1406 alist_element_buffer = Fcar (current_alist_element);
|
|
1407 if (EQ (alist_element_buffer, current_alist_element))
|
36819
|
1408 store_symval_forwarding (symbol,
|
|
1409 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
|
|
1410 value, NULL);
|
298
|
1411
|
|
1412 return value;
|
|
1413 }
|
|
1414
|
60064
|
1415 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
|
40123
|
1416 doc: /* Set the default value of variable VAR to VALUE.
|
|
1417 VAR, the variable name, is literal (not evaluated);
|
48961
|
1418 VALUE is an expression: it is evaluated and its value returned.
|
40123
|
1419 The default value of a variable is seen in buffers
|
|
1420 that do not have their own values for the variable.
|
|
1421
|
|
1422 More generally, you can use multiple variables and values, as in
|
55378
|
1423 (setq-default VAR VALUE VAR VALUE...)
|
|
1424 This sets each VAR's default value to the corresponding VALUE.
|
|
1425 The VALUE for the Nth VAR can refer to the new default values
|
|
1426 of previous VARs.
|
78140
|
1427 usage: (setq-default [VAR VALUE]...) */)
|
40123
|
1428 (args)
|
298
|
1429 Lisp_Object args;
|
|
1430 {
|
|
1431 register Lisp_Object args_left;
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1432 register Lisp_Object val, symbol;
|
298
|
1433 struct gcpro gcpro1;
|
|
1434
|
490
|
1435 if (NILP (args))
|
298
|
1436 return Qnil;
|
|
1437
|
|
1438 args_left = args;
|
|
1439 GCPRO1 (args);
|
|
1440
|
|
1441 do
|
|
1442 {
|
|
1443 val = Feval (Fcar (Fcdr (args_left)));
|
46279
|
1444 symbol = XCAR (args_left);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1445 Fset_default (symbol, val);
|
46279
|
1446 args_left = Fcdr (XCDR (args_left));
|
298
|
1447 }
|
490
|
1448 while (!NILP (args_left));
|
298
|
1449
|
|
1450 UNGCPRO;
|
|
1451 return val;
|
|
1452 }
|
|
1453
|
1278
|
1454 /* Lisp functions for creating and removing buffer-local variables. */
|
|
1455
|
298
|
1456 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
|
40123
|
1457 1, 1, "vMake Variable Buffer Local: ",
|
|
1458 doc: /* Make VARIABLE become buffer-local whenever it is set.
|
|
1459 At any time, the value for the current buffer is in effect,
|
|
1460 unless the variable has never been set in this buffer,
|
|
1461 in which case the default value is in effect.
|
|
1462 Note that binding the variable with `let', or setting it while
|
|
1463 a `let'-style binding made in this buffer is in effect,
|
48961
|
1464 does not make the variable buffer-local. Return VARIABLE.
|
40123
|
1465
|
58733
|
1466 In most cases it is better to use `make-local-variable',
|
|
1467 which makes a variable local in just one buffer.
|
|
1468
|
40123
|
1469 The function `default-value' gets the default value and `set-default' sets it. */)
|
|
1470 (variable)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1471 register Lisp_Object variable;
|
298
|
1472 {
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1473 register Lisp_Object tem, valcontents, newval;
|
95112
|
1474 struct Lisp_Symbol *sym;
|
298
|
1475
|
40656
|
1476 CHECK_SYMBOL (variable);
|
95112
|
1477 sym = indirect_variable (XSYMBOL (variable));
|
|
1478
|
|
1479 valcontents = sym->value;
|
|
1480 if (sym->constant || KBOARD_OBJFWDP (valcontents))
|
|
1481 error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
|
298
|
1482
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1483 if (BUFFER_OBJFWDP (valcontents))
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1484 return variable;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1485 else if (BUFFER_LOCAL_VALUEP (valcontents))
|
95407
|
1486 {
|
|
1487 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
|
|
1488 error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
|
|
1489 newval = valcontents;
|
|
1490 }
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1491 else
|
298
|
1492 {
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1493 if (EQ (valcontents, Qunbound))
|
95112
|
1494 sym->value = Qnil;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1495 tem = Fcons (Qnil, Fsymbol_value (variable));
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1496 XSETCAR (tem, tem);
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1497 newval = allocate_misc ();
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1498 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
|
95112
|
1499 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1500 XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer ();
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1501 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1502 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1503 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1504 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1505 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
|
95112
|
1506 sym->value = newval;
|
298
|
1507 }
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1508 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1;
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1509 return variable;
|
298
|
1510 }
|
|
1511
|
|
1512 DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
|
40123
|
1513 1, 1, "vMake Local Variable: ",
|
|
1514 doc: /* Make VARIABLE have a separate value in the current buffer.
|
|
1515 Other buffers will continue to share a common default value.
|
|
1516 \(The buffer-local value of VARIABLE starts out as the same value
|
|
1517 VARIABLE previously had. If VARIABLE was void, it remains void.\)
|
58733
|
1518 Return VARIABLE.
|
40123
|
1519
|
|
1520 If the variable is already arranged to become local when set,
|
|
1521 this function causes a local value to exist for this buffer,
|
|
1522 just as setting the variable would do.
|
|
1523
|
|
1524 This function returns VARIABLE, and therefore
|
|
1525 (set (make-local-variable 'VARIABLE) VALUE-EXP)
|
|
1526 works.
|
|
1527
|
58733
|
1528 See also `make-variable-buffer-local'.
|
|
1529
|
40123
|
1530 Do not use `make-local-variable' to make a hook variable buffer-local.
|
40628
|
1531 Instead, use `add-hook' and specify t for the LOCAL argument. */)
|
40123
|
1532 (variable)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1533 register Lisp_Object variable;
|
298
|
1534 {
|
|
1535 register Lisp_Object tem, valcontents;
|
95112
|
1536 struct Lisp_Symbol *sym;
|
298
|
1537
|
40656
|
1538 CHECK_SYMBOL (variable);
|
95112
|
1539 sym = indirect_variable (XSYMBOL (variable));
|
|
1540
|
|
1541 valcontents = sym->value;
|
95407
|
1542 if (sym->constant || KBOARD_OBJFWDP (valcontents)
|
|
1543 || (BUFFER_LOCAL_VALUEP (valcontents)
|
|
1544 && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)))
|
95112
|
1545 error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
|
298
|
1546
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1547 if ((BUFFER_LOCAL_VALUEP (valcontents)
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1548 && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1549 || BUFFER_OBJFWDP (valcontents))
|
298
|
1550 {
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1551 tem = Fboundp (variable);
|
10605
|
1552
|
298
|
1553 /* Make sure the symbol has a local value in this particular buffer,
|
|
1554 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
|
1555 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
|
1556 return variable;
|
298
|
1557 }
|
27778
|
1558 /* Make sure symbol is set up to hold per-buffer values. */
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1559 if (!BUFFER_LOCAL_VALUEP (valcontents))
|
298
|
1560 {
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1561 Lisp_Object newval;
|
298
|
1562 tem = Fcons (Qnil, do_symval_forwarding (valcontents));
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1563 XSETCAR (tem, tem);
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1564 newval = allocate_misc ();
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1565 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
|
95112
|
1566 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
|
21144
|
1567 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
|
|
1568 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1569 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
|
21144
|
1570 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
|
|
1571 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
|
|
1572 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
|
|
1573 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
|
95112
|
1574 sym->value = newval;
|
298
|
1575 }
|
27778
|
1576 /* Make sure this buffer has its own value of symbol. */
|
95112
|
1577 XSETSYMBOL (variable, sym); /* Propagate variable indirections. */
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1578 tem = Fassq (variable, current_buffer->local_var_alist);
|
490
|
1579 if (NILP (tem))
|
298
|
1580 {
|
13593
|
1581 /* Swap out any local binding for some other buffer, and make
|
|
1582 sure the current value is permanently recorded, if it's the
|
|
1583 default value. */
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1584 find_symbol_value (variable);
|
13593
|
1585
|
298
|
1586 current_buffer->local_var_alist
|
95112
|
1587 = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (sym->value)->cdr)),
|
298
|
1588 current_buffer->local_var_alist);
|
|
1589
|
|
1590 /* Make sure symbol does not think it is set up for this buffer;
|
27778
|
1591 force it to look once again for this buffer's value. */
|
298
|
1592 {
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1593 Lisp_Object *pvalbuf;
|
13593
|
1594
|
95112
|
1595 valcontents = sym->value;
|
13593
|
1596
|
21144
|
1597 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1598 if (current_buffer == XBUFFER (*pvalbuf))
|
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1599 *pvalbuf = Qnil;
|
21144
|
1600 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
|
298
|
1601 }
|
1278
|
1602 }
|
298
|
1603
|
27778
|
1604 /* If the symbol forwards into a C variable, then load the binding
|
|
1605 for this buffer now. If C code modifies the variable before we
|
|
1606 load the binding in, then that new value will clobber the default
|
|
1607 binding the next time we unload it. */
|
95112
|
1608 valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue;
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1609 if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
|
95112
|
1610 swap_in_symval_forwarding (variable, sym->value);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1611
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1612 return variable;
|
298
|
1613 }
|
|
1614
|
|
1615 DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
|
40123
|
1616 1, 1, "vKill Local Variable: ",
|
|
1617 doc: /* Make VARIABLE no longer have a separate value in the current buffer.
|
48961
|
1618 From now on the default value will apply in this buffer. Return VARIABLE. */)
|
40123
|
1619 (variable)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1620 register Lisp_Object variable;
|
298
|
1621 {
|
|
1622 register Lisp_Object tem, valcontents;
|
95112
|
1623 struct Lisp_Symbol *sym;
|
298
|
1624
|
40656
|
1625 CHECK_SYMBOL (variable);
|
95112
|
1626 sym = indirect_variable (XSYMBOL (variable));
|
|
1627
|
|
1628 valcontents = sym->value;
|
298
|
1629
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1630 if (BUFFER_OBJFWDP (valcontents))
|
298
|
1631 {
|
28312
|
1632 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
28351
|
1633 int idx = PER_BUFFER_IDX (offset);
|
28312
|
1634
|
|
1635 if (idx > 0)
|
298
|
1636 {
|
28351
|
1637 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
|
|
1638 PER_BUFFER_VALUE (current_buffer, offset)
|
|
1639 = PER_BUFFER_DEFAULT (offset);
|
298
|
1640 }
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1641 return variable;
|
298
|
1642 }
|
|
1643
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1644 if (!BUFFER_LOCAL_VALUEP (valcontents))
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1645 return variable;
|
298
|
1646
|
27778
|
1647 /* Get rid of this buffer's alist element, if any. */
|
95112
|
1648 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1649 tem = Fassq (variable, current_buffer->local_var_alist);
|
490
|
1650 if (!NILP (tem))
|
9895
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1651 current_buffer->local_var_alist
|
924f7b9ce544
(store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1652 = Fdelq (tem, current_buffer->local_var_alist);
|
298
|
1653
|
27778
|
1654 /* If the symbol is set up with the current buffer's binding
|
|
1655 loaded, recompute its value. We have to do it now, or else
|
|
1656 forwarded objects won't work right. */
|
298
|
1657 {
|
50305
|
1658 Lisp_Object *pvalbuf, buf;
|
95112
|
1659 valcontents = sym->value;
|
21144
|
1660 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
|
50305
|
1661 XSETBUFFER (buf, current_buffer);
|
|
1662 if (EQ (buf, *pvalbuf))
|
14264
|
1663 {
|
|
1664 *pvalbuf = Qnil;
|
21144
|
1665 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
|
14745
|
1666 find_symbol_value (variable);
|
14264
|
1667 }
|
298
|
1668 }
|
|
1669
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1670 return variable;
|
298
|
1671 }
|
9194
|
1672
|
21144
|
1673 /* Lisp functions for creating and removing buffer-local variables. */
|
|
1674
|
97885
|
1675 /* Obsolete since 22.2. NB adjust doc of modify-frame-parameters
|
|
1676 when/if this is removed. */
|
|
1677
|
21144
|
1678 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
|
40123
|
1679 1, 1, "vMake Variable Frame Local: ",
|
|
1680 doc: /* Enable VARIABLE to have frame-local bindings.
|
66542
|
1681 This does not create any frame-local bindings for VARIABLE,
|
|
1682 it just makes them possible.
|
|
1683
|
|
1684 A frame-local binding is actually a frame parameter value.
|
|
1685 If a frame F has a value for the frame parameter named VARIABLE,
|
|
1686 that also acts as a frame-local binding for VARIABLE in F--
|
|
1687 provided this function has been called to enable VARIABLE
|
|
1688 to have frame-local bindings at all.
|
|
1689
|
|
1690 The only way to create a frame-local binding for VARIABLE in a frame
|
|
1691 is to set the VARIABLE frame parameter of that frame. See
|
|
1692 `modify-frame-parameters' for how to set frame parameters.
|
|
1693
|
97886
|
1694 Note that since Emacs 23.1, variables cannot be both buffer-local and
|
|
1695 frame-local any more (buffer-local bindings used to take precedence over
|
|
1696 frame-local bindings). */)
|
40123
|
1697 (variable)
|
21144
|
1698 register Lisp_Object variable;
|
|
1699 {
|
|
1700 register Lisp_Object tem, valcontents, newval;
|
95112
|
1701 struct Lisp_Symbol *sym;
|
21144
|
1702
|
40656
|
1703 CHECK_SYMBOL (variable);
|
95112
|
1704 sym = indirect_variable (XSYMBOL (variable));
|
|
1705
|
|
1706 valcontents = sym->value;
|
|
1707 if (sym->constant || KBOARD_OBJFWDP (valcontents)
|
21144
|
1708 || BUFFER_OBJFWDP (valcontents))
|
95112
|
1709 error ("Symbol %s may not be frame-local", SDATA (sym->xname));
|
21144
|
1710
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1711 if (BUFFER_LOCAL_VALUEP (valcontents))
|
27778
|
1712 {
|
95407
|
1713 if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
|
|
1714 error ("Symbol %s may not be frame-local", SDATA (sym->xname));
|
27778
|
1715 return variable;
|
|
1716 }
|
21144
|
1717
|
|
1718 if (EQ (valcontents, Qunbound))
|
95112
|
1719 sym->value = Qnil;
|
21144
|
1720 tem = Fcons (Qnil, Fsymbol_value (variable));
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1721 XSETCAR (tem, tem);
|
21144
|
1722 newval = allocate_misc ();
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1723 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
|
95112
|
1724 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
|
21144
|
1725 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
|
|
1726 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1727 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
|
21144
|
1728 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
|
|
1729 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
|
|
1730 XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
|
|
1731 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
|
95112
|
1732 sym->value = newval;
|
21144
|
1733 return variable;
|
|
1734 }
|
|
1735
|
9194
|
1736 DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
|
40123
|
1737 1, 2, 0,
|
|
1738 doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
|
|
1739 BUFFER defaults to the current buffer. */)
|
|
1740 (variable, buffer)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1741 register Lisp_Object variable, buffer;
|
9194
|
1742 {
|
|
1743 Lisp_Object valcontents;
|
12113
|
1744 register struct buffer *buf;
|
95112
|
1745 struct Lisp_Symbol *sym;
|
12113
|
1746
|
|
1747 if (NILP (buffer))
|
|
1748 buf = current_buffer;
|
|
1749 else
|
|
1750 {
|
40656
|
1751 CHECK_BUFFER (buffer);
|
12113
|
1752 buf = XBUFFER (buffer);
|
|
1753 }
|
9194
|
1754
|
40656
|
1755 CHECK_SYMBOL (variable);
|
95112
|
1756 sym = indirect_variable (XSYMBOL (variable));
|
|
1757 XSETSYMBOL (variable, sym);
|
|
1758
|
|
1759 valcontents = sym->value;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1760 if (BUFFER_LOCAL_VALUEP (valcontents))
|
12113
|
1761 {
|
|
1762 Lisp_Object tail, elt;
|
39575
|
1763
|
26164
|
1764 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
|
12113
|
1765 {
|
26164
|
1766 elt = XCAR (tail);
|
|
1767 if (EQ (variable, XCAR (elt)))
|
12113
|
1768 return Qt;
|
|
1769 }
|
|
1770 }
|
|
1771 if (BUFFER_OBJFWDP (valcontents))
|
|
1772 {
|
|
1773 int offset = XBUFFER_OBJFWD (valcontents)->offset;
|
28351
|
1774 int idx = PER_BUFFER_IDX (offset);
|
|
1775 if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
|
12113
|
1776 return Qt;
|
|
1777 }
|
|
1778 return Qnil;
|
9194
|
1779 }
|
12295
|
1780
|
|
1781 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
|
40123
|
1782 1, 2, 0,
|
57618
|
1783 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
|
|
1784 More precisely, this means that setting the variable \(with `set' or`setq'),
|
|
1785 while it does not have a `let'-style binding that was made in BUFFER,
|
|
1786 will produce a buffer local binding. See Info node
|
|
1787 `(elisp)Creating Buffer-Local'.
|
40123
|
1788 BUFFER defaults to the current buffer. */)
|
|
1789 (variable, buffer)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1790 register Lisp_Object variable, buffer;
|
12295
|
1791 {
|
|
1792 Lisp_Object valcontents;
|
|
1793 register struct buffer *buf;
|
95112
|
1794 struct Lisp_Symbol *sym;
|
12295
|
1795
|
|
1796 if (NILP (buffer))
|
|
1797 buf = current_buffer;
|
|
1798 else
|
|
1799 {
|
40656
|
1800 CHECK_BUFFER (buffer);
|
12295
|
1801 buf = XBUFFER (buffer);
|
|
1802 }
|
|
1803
|
40656
|
1804 CHECK_SYMBOL (variable);
|
95112
|
1805 sym = indirect_variable (XSYMBOL (variable));
|
|
1806 XSETSYMBOL (variable, sym);
|
|
1807
|
|
1808 valcontents = sym->value;
|
12295
|
1809
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1810 if (BUFFER_OBJFWDP (valcontents))
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1811 /* All these slots become local if they are set. */
|
12295
|
1812 return Qt;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1813 else if (BUFFER_LOCAL_VALUEP (valcontents))
|
12295
|
1814 {
|
|
1815 Lisp_Object tail, elt;
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1816 if (XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
|
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1817 return Qt;
|
26164
|
1818 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
|
12295
|
1819 {
|
26164
|
1820 elt = XCAR (tail);
|
|
1821 if (EQ (variable, XCAR (elt)))
|
12295
|
1822 return Qt;
|
|
1823 }
|
|
1824 }
|
|
1825 return Qnil;
|
|
1826 }
|
52537
|
1827
|
|
1828 DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus,
|
|
1829 1, 1, 0,
|
|
1830 doc: /* Return a value indicating where VARIABLE's current binding comes from.
|
|
1831 If the current binding is buffer-local, the value is the current buffer.
|
|
1832 If the current binding is frame-local, the value is the selected frame.
|
|
1833 If the current binding is global (the default), the value is nil. */)
|
|
1834 (variable)
|
|
1835 register Lisp_Object variable;
|
|
1836 {
|
|
1837 Lisp_Object valcontents;
|
95112
|
1838 struct Lisp_Symbol *sym;
|
52537
|
1839
|
|
1840 CHECK_SYMBOL (variable);
|
95112
|
1841 sym = indirect_variable (XSYMBOL (variable));
|
52537
|
1842
|
|
1843 /* Make sure the current binding is actually swapped in. */
|
|
1844 find_symbol_value (variable);
|
|
1845
|
95112
|
1846 valcontents = sym->value;
|
52537
|
1847
|
|
1848 if (BUFFER_LOCAL_VALUEP (valcontents)
|
|
1849 || BUFFER_OBJFWDP (valcontents))
|
|
1850 {
|
|
1851 /* For a local variable, record both the symbol and which
|
|
1852 buffer's or frame's value we are saving. */
|
|
1853 if (!NILP (Flocal_variable_p (variable, Qnil)))
|
|
1854 return Fcurrent_buffer ();
|
85328
d0d527210b0c
* lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1855 else if (BUFFER_LOCAL_VALUEP (valcontents)
|
52537
|
1856 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
|
|
1857 return XBUFFER_LOCAL_VALUE (valcontents)->frame;
|
|
1858 }
|
|
1859
|
|
1860 return Qnil;
|
|
1861 }
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1862
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1863 /* This code is disabled now that we use the selected frame to return
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1864 keyboard-local-values. */
|
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1865 #if 0
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1866 extern struct terminal *get_terminal P_ ((Lisp_Object display, int));
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1867
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1868 DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1869 doc: /* Return the terminal-local value of SYMBOL on TERMINAL.
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1870 If SYMBOL is not a terminal-local variable, then return its normal
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1871 value, like `symbol-value'.
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1872
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1873 TERMINAL may be a terminal id, a frame, or nil (meaning the
|
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1874 selected frame's terminal device). */)
|
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1875 (symbol, terminal)
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1876 Lisp_Object symbol;
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1877 Lisp_Object terminal;
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1878 {
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1879 Lisp_Object result;
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1880 struct terminal *t = get_terminal (terminal, 1);
|
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1881 push_kboard (t->kboard);
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1882 result = Fsymbol_value (symbol);
|
83374
0b75ace4f7ad
Fix crash after y-or-n-p prompt triggered by emacsclient. (Reported by Han Boetes, analysis by Kalle Olavi Niemitalo.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1883 pop_kboard ();
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1884 return result;
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1885 }
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1886
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1887 DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0,
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1888 doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE.
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1889 If VARIABLE is not a terminal-local variable, then set its normal
|
83342
9216636c02fc
Rename `struct display' to `struct device'. Update function, parameter and variable names accordingly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1890 binding, like `set'.
|
9216636c02fc
Rename `struct display' to `struct device'. Update function, parameter and variable names accordingly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1891
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1892 TERMINAL may be a terminal id, a frame, or nil (meaning the
|
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1893 selected frame's terminal device). */)
|
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1894 (symbol, terminal, value)
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1895 Lisp_Object symbol;
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1896 Lisp_Object terminal;
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1897 Lisp_Object value;
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1898 {
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1899 Lisp_Object result;
|
83431
76396de7f50a
Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1900 struct terminal *t = get_terminal (terminal, 1);
|
83374
0b75ace4f7ad
Fix crash after y-or-n-p prompt triggered by emacsclient. (Reported by Han Boetes, analysis by Kalle Olavi Niemitalo.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1901 push_kboard (d->kboard);
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1902 result = Fset (symbol, value);
|
83374
0b75ace4f7ad
Fix crash after y-or-n-p prompt triggered by emacsclient. (Reported by Han Boetes, analysis by Kalle Olavi Niemitalo.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1903 pop_kboard ();
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1904 return result;
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1905 }
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1906 #endif
|
298
|
1907
|
648
|
1908 /* Find the function at the end of a chain of symbol function indirections. */
|
|
1909
|
|
1910 /* If OBJECT is a symbol, find the end of its function chain and
|
|
1911 return the value found there. If OBJECT is not a symbol, just
|
|
1912 return it. If there is a cycle in the function chain, signal a
|
|
1913 cyclic-function-indirection error.
|
|
1914
|
|
1915 This is like Findirect_function, except that it doesn't signal an
|
|
1916 error if the chain ends up unbound. */
|
|
1917 Lisp_Object
|
1648
|
1918 indirect_function (object)
|
9194
|
1919 register Lisp_Object object;
|
648
|
1920 {
|
3591
|
1921 Lisp_Object tortoise, hare;
|
648
|
1922
|
3591
|
1923 hare = tortoise = object;
|
648
|
1924
|
|
1925 for (;;)
|
|
1926 {
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1927 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
|
648
|
1928 break;
|
|
1929 hare = XSYMBOL (hare)->function;
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1930 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
|
648
|
1931 break;
|
|
1932 hare = XSYMBOL (hare)->function;
|
|
1933
|
3591
|
1934 tortoise = XSYMBOL (tortoise)->function;
|
648
|
1935
|
3591
|
1936 if (EQ (hare, tortoise))
|
71973
|
1937 xsignal1 (Qcyclic_function_indirection, object);
|
648
|
1938 }
|
|
1939
|
|
1940 return hare;
|
|
1941 }
|
|
1942
|
68758
|
1943 DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
|
40123
|
1944 doc: /* Return the function at the end of OBJECT's function chain.
|
68780
|
1945 If OBJECT is not a symbol, just return it. Otherwise, follow all
|
|
1946 function indirections to find the final function binding and return it.
|
|
1947 If the final symbol in the chain is unbound, signal a void-function error.
|
|
1948 Optional arg NOERROR non-nil means to return nil instead of signalling.
|
40123
|
1949 Signal a cyclic-function-indirection error if there is a loop in the
|
|
1950 function chain of symbols. */)
|
68780
|
1951 (object, noerror)
|
40123
|
1952 register Lisp_Object object;
|
68780
|
1953 Lisp_Object noerror;
|
648
|
1954 {
|
|
1955 Lisp_Object result;
|
|
1956
|
71871
|
1957 /* Optimize for no indirection. */
|
|
1958 result = object;
|
|
1959 if (SYMBOLP (result) && !EQ (result, Qunbound)
|
|
1960 && (result = XSYMBOL (result)->function, SYMBOLP (result)))
|
|
1961 result = indirect_function (result);
|
|
1962 if (!EQ (result, Qunbound))
|
|
1963 return result;
|
|
1964
|
|
1965 if (NILP (noerror))
|
71973
|
1966 xsignal1 (Qvoid_function, object);
|
71871
|
1967
|
|
1968 return Qnil;
|
648
|
1969 }
|
|
1970
|
298
|
1971 /* Extract and set vector and string elements */
|
|
1972
|
|
1973 DEFUN ("aref", Faref, Saref, 2, 2, 0,
|
40123
|
1974 doc: /* Return the element of ARRAY at index IDX.
|
|
1975 ARRAY may be a vector, a string, a char-table, a bool-vector,
|
|
1976 or a byte-code object. IDX starts at 0. */)
|
|
1977 (array, idx)
|
298
|
1978 register Lisp_Object array;
|
|
1979 Lisp_Object idx;
|
|
1980 {
|
|
1981 register int idxval;
|
|
1982
|
40656
|
1983 CHECK_NUMBER (idx);
|
298
|
1984 idxval = XINT (idx);
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1985 if (STRINGP (array))
|
298
|
1986 {
|
20617
|
1987 int c, idxval_byte;
|
|
1988
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1989 if (idxval < 0 || idxval >= SCHARS (array))
|
9966
|
1990 args_out_of_range (array, idx);
|
20617
|
1991 if (! STRING_MULTIBYTE (array))
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1992 return make_number ((unsigned char) SREF (array, idxval));
|
20617
|
1993 idxval_byte = string_char_to_byte (array, idxval);
|
|
1994
|
46422
|
1995 c = STRING_CHAR (SDATA (array) + idxval_byte,
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1996 SBYTES (array) - idxval_byte);
|
20617
|
1997 return make_number (c);
|
298
|
1998 }
|
13148
|
1999 else if (BOOL_VECTOR_P (array))
|
|
2000 {
|
|
2001 int val;
|
|
2002
|
|
2003 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
|
|
2004 args_out_of_range (array, idx);
|
|
2005
|
55160
|
2006 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
|
|
2007 return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil);
|
13148
|
2008 }
|
|
2009 else if (CHAR_TABLE_P (array))
|
|
2010 {
|
88368
|
2011 CHECK_CHARACTER (idx);
|
|
2012 return CHAR_TABLE_REF (array, idxval);
|
13148
|
2013 }
|
298
|
2014 else
|
9966
|
2015 {
|
31829
|
2016 int size = 0;
|
10290
|
2017 if (VECTORP (array))
|
|
2018 size = XVECTOR (array)->size;
|
|
2019 else if (COMPILEDP (array))
|
|
2020 size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
|
|
2021 else
|
|
2022 wrong_type_argument (Qarrayp, array);
|
|
2023
|
|
2024 if (idxval < 0 || idxval >= size)
|
9966
|
2025 args_out_of_range (array, idx);
|
|
2026 return XVECTOR (array)->contents[idxval];
|
|
2027 }
|
298
|
2028 }
|
|
2029
|
|
2030 DEFUN ("aset", Faset, Saset, 3, 3, 0,
|
40123
|
2031 doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
|
48961
|
2032 Return NEWELT. ARRAY may be a vector, a string, a char-table or a
|
|
2033 bool-vector. IDX starts at 0. */)
|
40123
|
2034 (array, idx, newelt)
|
298
|
2035 register Lisp_Object array;
|
|
2036 Lisp_Object idx, newelt;
|
|
2037 {
|
|
2038 register int idxval;
|
|
2039
|
40656
|
2040 CHECK_NUMBER (idx);
|
298
|
2041 idxval = XINT (idx);
|
71830
|
2042 CHECK_ARRAY (array, Qarrayp);
|
298
|
2043 CHECK_IMPURE (array);
|
|
2044
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2045 if (VECTORP (array))
|
9966
|
2046 {
|
|
2047 if (idxval < 0 || idxval >= XVECTOR (array)->size)
|
|
2048 args_out_of_range (array, idx);
|
|
2049 XVECTOR (array)->contents[idxval] = newelt;
|
|
2050 }
|
13148
|
2051 else if (BOOL_VECTOR_P (array))
|
|
2052 {
|
|
2053 int val;
|
|
2054
|
|
2055 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
|
|
2056 args_out_of_range (array, idx);
|
|
2057
|
55160
|
2058 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
|
13148
|
2059
|
|
2060 if (! NILP (newelt))
|
55160
|
2061 val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR);
|
13148
|
2062 else
|
55160
|
2063 val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR));
|
|
2064 XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val;
|
13148
|
2065 }
|
|
2066 else if (CHAR_TABLE_P (array))
|
|
2067 {
|
88368
|
2068 CHECK_CHARACTER (idx);
|
|
2069 CHAR_TABLE_SET (array, idxval, newelt);
|
13148
|
2070 }
|
20617
|
2071 else if (STRING_MULTIBYTE (array))
|
|
2072 {
|
50632
|
2073 int idxval_byte, prev_bytes, new_bytes, nbytes;
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2074 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
|
20617
|
2075
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2076 if (idxval < 0 || idxval >= SCHARS (array))
|
20617
|
2077 args_out_of_range (array, idx);
|
89526
|
2078 CHECK_CHARACTER (newelt);
|
20617
|
2079
|
50632
|
2080 nbytes = SBYTES (array);
|
|
2081
|
20617
|
2082 idxval_byte = string_char_to_byte (array, idxval);
|
46422
|
2083 p1 = SDATA (array) + idxval_byte;
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2084 PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2085 new_bytes = CHAR_STRING (XINT (newelt), p0);
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2086 if (prev_bytes != new_bytes)
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2087 {
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2088 /* We must relocate the string data. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2089 int nchars = SCHARS (array);
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2090 unsigned char *str;
|
56193
|
2091 USE_SAFE_ALLOCA;
|
|
2092
|
|
2093 SAFE_ALLOCA (str, unsigned char *, nbytes);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2094 bcopy (SDATA (array), str, nbytes);
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2095 allocate_string_data (XSTRING (array), nchars,
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2096 nbytes + new_bytes - prev_bytes);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2097 bcopy (str, SDATA (array), idxval_byte);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2098 p1 = SDATA (array) + idxval_byte;
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2099 bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2100 nbytes - (idxval_byte + prev_bytes));
|
57726
|
2101 SAFE_FREE ();
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2102 clear_string_char_byte_cache ();
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2103 }
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2104 while (new_bytes--)
|
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2105 *p1++ = *p0++;
|
20617
|
2106 }
|
298
|
2107 else
|
|
2108 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2109 if (idxval < 0 || idxval >= SCHARS (array))
|
9966
|
2110 args_out_of_range (array, idx);
|
40656
|
2111 CHECK_NUMBER (newelt);
|
30356
b600a31684db
(Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2112
|
90321
|
2113 if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt)))
|
94122
|
2114 {
|
|
2115 int i;
|
|
2116
|
|
2117 for (i = SBYTES (array) - 1; i >= 0; i--)
|
|
2118 if (SREF (array, i) >= 0x80)
|
|
2119 args_out_of_range (array, newelt);
|
|
2120 /* ARRAY is an ASCII string. Convert it to a multibyte
|
|
2121 string, and try `aset' again. */
|
|
2122 STRING_SET_MULTIBYTE (array);
|
|
2123 return Faset (array, idx, newelt);
|
|
2124 }
|
90321
|
2125 SSET (array, idxval, XINT (newelt));
|
298
|
2126 }
|
|
2127
|
|
2128 return newelt;
|
|
2129 }
|
|
2130
|
|
2131 /* Arithmetic functions */
|
|
2132
|
|
2133 enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
|
|
2134
|
|
2135 Lisp_Object
|
|
2136 arithcompare (num1, num2, comparison)
|
|
2137 Lisp_Object num1, num2;
|
|
2138 enum comparison comparison;
|
|
2139 {
|
31829
|
2140 double f1 = 0, f2 = 0;
|
298
|
2141 int floatp = 0;
|
|
2142
|
40656
|
2143 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
|
|
2144 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
|
298
|
2145
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2146 if (FLOATP (num1) || FLOATP (num2))
|
298
|
2147 {
|
|
2148 floatp = 1;
|
26164
|
2149 f1 = (FLOATP (num1)) ? XFLOAT_DATA (num1) : XINT (num1);
|
|
2150 f2 = (FLOATP (num2)) ? XFLOAT_DATA (num2) : XINT (num2);
|
298
|
2151 }
|
|
2152
|
|
2153 switch (comparison)
|
|
2154 {
|
|
2155 case equal:
|
|
2156 if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
|
|
2157 return Qt;
|
|
2158 return Qnil;
|
|
2159
|
|
2160 case notequal:
|
|
2161 if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
|
|
2162 return Qt;
|
|
2163 return Qnil;
|
|
2164
|
|
2165 case less:
|
|
2166 if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
|
|
2167 return Qt;
|
|
2168 return Qnil;
|
|
2169
|
|
2170 case less_or_equal:
|
|
2171 if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
|
|
2172 return Qt;
|
|
2173 return Qnil;
|
|
2174
|
|
2175 case grtr:
|
|
2176 if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
|
|
2177 return Qt;
|
|
2178 return Qnil;
|
|
2179
|
|
2180 case grtr_or_equal:
|
|
2181 if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
|
|
2182 return Qt;
|
|
2183 return Qnil;
|
1914
|
2184
|
|
2185 default:
|
|
2186 abort ();
|
298
|
2187 }
|
|
2188 }
|
|
2189
|
|
2190 DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
|
40123
|
2191 doc: /* Return t if two args, both numbers or markers, are equal. */)
|
|
2192 (num1, num2)
|
298
|
2193 register Lisp_Object num1, num2;
|
|
2194 {
|
|
2195 return arithcompare (num1, num2, equal);
|
|
2196 }
|
|
2197
|
|
2198 DEFUN ("<", Flss, Slss, 2, 2, 0,
|
40123
|
2199 doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */)
|
|
2200 (num1, num2)
|
298
|
2201 register Lisp_Object num1, num2;
|
|
2202 {
|
|
2203 return arithcompare (num1, num2, less);
|
|
2204 }
|
|
2205
|
|
2206 DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
|
40123
|
2207 doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */)
|
|
2208 (num1, num2)
|
298
|
2209 register Lisp_Object num1, num2;
|
|
2210 {
|
|
2211 return arithcompare (num1, num2, grtr);
|
|
2212 }
|
|
2213
|
|
2214 DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
|
40123
|
2215 doc: /* Return t if first arg is less than or equal to second arg.
|
|
2216 Both must be numbers or markers. */)
|
|
2217 (num1, num2)
|
298
|
2218 register Lisp_Object num1, num2;
|
|
2219 {
|
|
2220 return arithcompare (num1, num2, less_or_equal);
|
|
2221 }
|
|
2222
|
|
2223 DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
|
40123
|
2224 doc: /* Return t if first arg is greater than or equal to second arg.
|
|
2225 Both must be numbers or markers. */)
|
|
2226 (num1, num2)
|
298
|
2227 register Lisp_Object num1, num2;
|
|
2228 {
|
|
2229 return arithcompare (num1, num2, grtr_or_equal);
|
|
2230 }
|
|
2231
|
|
2232 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
|
40123
|
2233 doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */)
|
|
2234 (num1, num2)
|
298
|
2235 register Lisp_Object num1, num2;
|
|
2236 {
|
|
2237 return arithcompare (num1, num2, notequal);
|
|
2238 }
|
|
2239
|
40123
|
2240 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
|
|
2241 doc: /* Return t if NUMBER is zero. */)
|
|
2242 (number)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2243 register Lisp_Object number;
|
298
|
2244 {
|
40656
|
2245 CHECK_NUMBER_OR_FLOAT (number);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2246
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2247 if (FLOATP (number))
|
298
|
2248 {
|
26164
|
2249 if (XFLOAT_DATA (number) == 0.0)
|
298
|
2250 return Qt;
|
|
2251 return Qnil;
|
|
2252 }
|
|
2253
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2254 if (!XINT (number))
|
298
|
2255 return Qt;
|
|
2256 return Qnil;
|
|
2257 }
|
|
2258
|
78140
|
2259 /* Convert between long values and pairs of Lisp integers.
|
|
2260 Note that long_to_cons returns a single Lisp integer
|
|
2261 when the value fits in one. */
|
2515
|
2262
|
|
2263 Lisp_Object
|
|
2264 long_to_cons (i)
|
|
2265 unsigned long i;
|
|
2266 {
|
50109
|
2267 unsigned long top = i >> 16;
|
2515
|
2268 unsigned int bot = i & 0xFFFF;
|
|
2269 if (top == 0)
|
|
2270 return make_number (bot);
|
11879
|
2271 if (top == (unsigned long)-1 >> 16)
|
2515
|
2272 return Fcons (make_number (-1), make_number (bot));
|
|
2273 return Fcons (make_number (top), make_number (bot));
|
|
2274 }
|
|
2275
|
|
2276 unsigned long
|
|
2277 cons_to_long (c)
|
|
2278 Lisp_Object c;
|
|
2279 {
|
3675
|
2280 Lisp_Object top, bot;
|
2515
|
2281 if (INTEGERP (c))
|
|
2282 return XINT (c);
|
26164
|
2283 top = XCAR (c);
|
|
2284 bot = XCDR (c);
|
2515
|
2285 if (CONSP (bot))
|
26164
|
2286 bot = XCAR (bot);
|
2515
|
2287 return ((XINT (top) << 16) | XINT (bot));
|
|
2288 }
|
|
2289
|
2429
|
2290 DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
|
48961
|
2291 doc: /* Return the decimal representation of NUMBER as a string.
|
40123
|
2292 Uses a minus sign if negative.
|
|
2293 NUMBER may be an integer or a floating point number. */)
|
|
2294 (number)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2295 Lisp_Object number;
|
298
|
2296 {
|
12528
|
2297 char buffer[VALBITS];
|
298
|
2298
|
40656
|
2299 CHECK_NUMBER_OR_FLOAT (number);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2300
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2301 if (FLOATP (number))
|
298
|
2302 {
|
|
2303 char pigbuf[350]; /* see comments in float_to_string */
|
|
2304
|
26164
|
2305 float_to_string (pigbuf, XFLOAT_DATA (number));
|
10605
|
2306 return build_string (pigbuf);
|
298
|
2307 }
|
|
2308
|
11701
|
2309 if (sizeof (int) == sizeof (EMACS_INT))
|
86330
|
2310 sprintf (buffer, "%d", (int) XINT (number));
|
11701
|
2311 else if (sizeof (long) == sizeof (EMACS_INT))
|
25780
|
2312 sprintf (buffer, "%ld", (long) XINT (number));
|
11701
|
2313 else
|
|
2314 abort ();
|
298
|
2315 return build_string (buffer);
|
|
2316 }
|
|
2317
|
17780
|
2318 INLINE static int
|
|
2319 digit_to_number (character, base)
|
|
2320 int character, base;
|
|
2321 {
|
|
2322 int digit;
|
|
2323
|
|
2324 if (character >= '0' && character <= '9')
|
|
2325 digit = character - '0';
|
|
2326 else if (character >= 'a' && character <= 'z')
|
|
2327 digit = character - 'a' + 10;
|
|
2328 else if (character >= 'A' && character <= 'Z')
|
|
2329 digit = character - 'A' + 10;
|
|
2330 else
|
|
2331 return -1;
|
|
2332
|
|
2333 if (digit >= base)
|
|
2334 return -1;
|
|
2335 else
|
|
2336 return digit;
|
48961
|
2337 }
|
17780
|
2338
|
|
2339 DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
|
48996
|
2340 doc: /* Parse STRING as a decimal number and return the number.
|
40123
|
2341 This parses both integers and floating point numbers.
|
|
2342 It ignores leading spaces and tabs.
|
|
2343
|
|
2344 If BASE, interpret STRING as a number in that base. If BASE isn't
|
|
2345 present, base 10 is used. BASE must be between 2 and 16 (inclusive).
|
|
2346 If the base used is not 10, floating point is not recognized. */)
|
|
2347 (string, base)
|
17780
|
2348 register Lisp_Object string, base;
|
298
|
2349 {
|
17780
|
2350 register unsigned char *p;
|
27826
|
2351 register int b;
|
|
2352 int sign = 1;
|
|
2353 Lisp_Object val;
|
1914
|
2354
|
40656
|
2355 CHECK_STRING (string);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2356
|
17780
|
2357 if (NILP (base))
|
|
2358 b = 10;
|
|
2359 else
|
|
2360 {
|
40656
|
2361 CHECK_NUMBER (base);
|
17780
|
2362 b = XINT (base);
|
|
2363 if (b < 2 || b > 16)
|
71973
|
2364 xsignal1 (Qargs_out_of_range, base);
|
17780
|
2365 }
|
|
2366
|
1914
|
2367 /* Skip any whitespace at the front of the number. Some versions of
|
|
2368 atoi do this anyway, so we might as well make Emacs lisp consistent. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2369 p = SDATA (string);
|
1987
|
2370 while (*p == ' ' || *p == '\t')
|
1914
|
2371 p++;
|
|
2372
|
17780
|
2373 if (*p == '-')
|
|
2374 {
|
27826
|
2375 sign = -1;
|
17780
|
2376 p++;
|
|
2377 }
|
|
2378 else if (*p == '+')
|
|
2379 p++;
|
48961
|
2380
|
23420
460aba3ec682
(Fstring_to_number): Don't recognize floating point if base is not 10.
Kenichi Handa <handa@m17n.org>
diff
changeset
|
2381 if (isfloat_string (p) && b == 10)
|
27826
|
2382 val = make_float (sign * atof (p));
|
|
2383 else
|
17780
|
2384 {
|
27826
|
2385 double v = 0;
|
|
2386
|
|
2387 while (1)
|
|
2388 {
|
|
2389 int digit = digit_to_number (*p++, b);
|
|
2390 if (digit < 0)
|
|
2391 break;
|
|
2392 v = v * b + digit;
|
|
2393 }
|
|
2394
|
39775
|
2395 val = make_fixnum_or_float (sign * v);
|
17780
|
2396 }
|
27826
|
2397
|
|
2398 return val;
|
298
|
2399 }
|
17780
|
2400
|
10605
|
2401
|
298
|
2402 enum arithop
|
36819
|
2403 {
|
|
2404 Aadd,
|
|
2405 Asub,
|
|
2406 Amult,
|
|
2407 Adiv,
|
|
2408 Alogand,
|
|
2409 Alogior,
|
|
2410 Alogxor,
|
|
2411 Amax,
|
|
2412 Amin
|
|
2413 };
|
|
2414
|
|
2415 static Lisp_Object float_arith_driver P_ ((double, int, enum arithop,
|
|
2416 int, Lisp_Object *));
|
16787
|
2417 extern Lisp_Object fmod_float ();
|
1508
|
2418
|
298
|
2419 Lisp_Object
|
3338
|
2420 arith_driver (code, nargs, args)
|
298
|
2421 enum arithop code;
|
|
2422 int nargs;
|
|
2423 register Lisp_Object *args;
|
|
2424 {
|
|
2425 register Lisp_Object val;
|
|
2426 register int argnum;
|
36819
|
2427 register EMACS_INT accum = 0;
|
11688
|
2428 register EMACS_INT next;
|
298
|
2429
|
10457
2ab3bd0288a9
Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2430 switch (SWITCH_ENUM_CAST (code))
|
298
|
2431 {
|
|
2432 case Alogior:
|
|
2433 case Alogxor:
|
|
2434 case Aadd:
|
|
2435 case Asub:
|
36819
|
2436 accum = 0;
|
|
2437 break;
|
298
|
2438 case Amult:
|
36819
|
2439 accum = 1;
|
|
2440 break;
|
298
|
2441 case Alogand:
|
36819
|
2442 accum = -1;
|
|
2443 break;
|
|
2444 default:
|
|
2445 break;
|
298
|
2446 }
|
|
2447
|
|
2448 for (argnum = 0; argnum < nargs; argnum++)
|
|
2449 {
|
36819
|
2450 /* Using args[argnum] as argument to CHECK_NUMBER_... */
|
|
2451 val = args[argnum];
|
40656
|
2452 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
|
298
|
2453
|
36819
|
2454 if (FLOATP (val))
|
|
2455 return float_arith_driver ((double) accum, argnum, code,
|
|
2456 nargs, args);
|
|
2457 args[argnum] = val;
|
298
|
2458 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
|
2459 switch (SWITCH_ENUM_CAST (code))
|
298
|
2460 {
|
36819
|
2461 case Aadd:
|
|
2462 accum += next;
|
|
2463 break;
|
298
|
2464 case Asub:
|
23148
|
2465 accum = argnum ? accum - next : nargs == 1 ? - next : next;
|
298
|
2466 break;
|
36819
|
2467 case Amult:
|
|
2468 accum *= next;
|
|
2469 break;
|
298
|
2470 case Adiv:
|
36819
|
2471 if (!argnum)
|
|
2472 accum = next;
|
3338
|
2473 else
|
|
2474 {
|
|
2475 if (next == 0)
|
71973
|
2476 xsignal0 (Qarith_error);
|
3338
|
2477 accum /= next;
|
|
2478 }
|
298
|
2479 break;
|
36819
|
2480 case Alogand:
|
|
2481 accum &= next;
|
|
2482 break;
|
|
2483 case Alogior:
|
|
2484 accum |= next;
|
|
2485 break;
|
|
2486 case Alogxor:
|
|
2487 accum ^= next;
|
|
2488 break;
|
|
2489 case Amax:
|
|
2490 if (!argnum || next > accum)
|
|
2491 accum = next;
|
|
2492 break;
|
|
2493 case Amin:
|
|
2494 if (!argnum || next < accum)
|
|
2495 accum = next;
|
|
2496 break;
|
298
|
2497 }
|
|
2498 }
|
|
2499
|
9263
cda13734e32c
(make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2500 XSETINT (val, accum);
|
298
|
2501 return val;
|
|
2502 }
|
|
2503
|
6201
|
2504 #undef isnan
|
|
2505 #define isnan(x) ((x) != (x))
|
|
2506
|
36819
|
2507 static Lisp_Object
|
298
|
2508 float_arith_driver (accum, argnum, code, nargs, args)
|
|
2509 double accum;
|
|
2510 register int argnum;
|
|
2511 enum arithop code;
|
|
2512 int nargs;
|
|
2513 register Lisp_Object *args;
|
|
2514 {
|
|
2515 register Lisp_Object val;
|
|
2516 double next;
|
10605
|
2517
|
298
|
2518 for (; argnum < nargs; argnum++)
|
|
2519 {
|
|
2520 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */
|
40656
|
2521 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
|
298
|
2522
|
9147
ee9adbda1ad1
(wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2523 if (FLOATP (val))
|
298
|
2524 {
|
26164
|
2525 next = XFLOAT_DATA (val);
|
298
|
2526 }
|
|
2527 else
|
|
2528 {
|
|
2529 args[argnum] = val; /* runs into a compiler bug. */
|
|
2530 next = XINT (args[argnum]);
|
|
2531 }
|
10457
2ab3bd0288a9
Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2532 switch (SWITCH_ENUM_CAST (code))
|
298
|
2533 {
|
|
2534 case Aadd:
|
|
2535 accum += next;
|
|
2536 break;
|
|
2537 case Asub:
|
23148
|
2538 accum = argnum ? accum - next : nargs == 1 ? - next : next;
|
298
|
2539 break;
|
|
2540 case Amult:
|
|
2541 accum *= next;
|
|
2542 break;
|
|
2543 case Adiv:
|
|
2544 if (!argnum)
|
|
2545 accum = next;
|
|
2546 else
|
3338
|
2547 {
|
16787
|
2548 if (! IEEE_FLOATING_POINT && next == 0)
|
71973
|
2549 xsignal0 (Qarith_error);
|
3338
|
2550 accum /= next;
|
|
2551 }
|
298
|
2552 break;
|
|
2553 case Alogand:
|
|
2554 case Alogior:
|
|
2555 case Alogxor:
|
|
2556 return wrong_type_argument (Qinteger_or_marker_p, val);
|
|
2557 case Amax:
|
6201
|
2558 if (!argnum || isnan (next) || next > accum)
|
298
|
2559 accum = next;
|
|
2560 break;
|
|
2561 case Amin:
|
6201
|
2562 if (!argnum || isnan (next) || next < accum)
|
298
|
2563 accum = next;
|
|
2564 break;
|
|
2565 }
|
|
2566 }
|
|
2567
|
|
2568 return make_float (accum);
|
|
2569 }
|
27727
|
2570
|
298
|
2571
|
|
2572 DEFUN ("+", Fplus, Splus, 0, MANY, 0,
|
40123
|
2573 doc: /* Return sum of any number of arguments, which are numbers or markers.
|
|
2574 usage: (+ &rest NUMBERS-OR-MARKERS) */)
|
|
2575 (nargs, args)
|
298
|
2576 int nargs;
|
|
2577 Lisp_Object *args;
|
|
2578 {
|
|
2579 return arith_driver (Aadd, nargs, args);
|
|
2580 }
|
|
2581
|
|
2582 DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
|
48996
|
2583 doc: /* Negate number or subtract numbers or markers and return the result.
|
40123
|
2584 With one arg, negates it. With more than one arg,
|
40116
|
2585 subtracts all but the first from the first.
|
40123
|
2586 usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
|
|
2587 (nargs, args)
|
298
|
2588 int nargs;
|
|
2589 Lisp_Object *args;
|
|
2590 {
|
|
2591 return arith_driver (Asub, nargs, args);
|
|
2592 }
|
|
2593
|
|
2594 DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
|
41153
|
2595 doc: /* Return product of any number of arguments, which are numbers or markers.
|
40123
|
2596 usage: (* &rest NUMBERS-OR-MARKERS) */)
|
|
2597 (nargs, args)
|
298
|
2598 int nargs;
|
|
2599 Lisp_Object *args;
|
|
2600 {
|
|
2601 return arith_driver (Amult, nargs, args);
|
|
2602 }
|
|
2603
|
|
2604 DEFUN ("/", Fquo, Squo, 2, MANY, 0,
|
41153
|
2605 doc: /* Return first argument divided by all the remaining arguments.
|
40116
|
2606 The arguments must be numbers or markers.
|
40123
|
2607 usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
|
|
2608 (nargs, args)
|
298
|
2609 int nargs;
|
|
2610 Lisp_Object *args;
|
|
2611 {
|
55440
1ca30263e9d4
(Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2612 int argnum;
|
55455
|
2613 for (argnum = 2; argnum < nargs; argnum++)
|
55440
1ca30263e9d4
(Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2614 if (FLOATP (args[argnum]))
|
1ca30263e9d4
(Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2615 return float_arith_driver (0, 0, Adiv, nargs, args);
|
298
|
2616 return arith_driver (Adiv, nargs, args);
|
|
2617 }
|
|
2618
|
|
2619 DEFUN ("%", Frem, Srem, 2, 2, 0,
|
41153
|
2620 doc: /* Return remainder of X divided by Y.
|
40123
|
2621 Both must be integers or markers. */)
|
|
2622 (x, y)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2623 register Lisp_Object x, y;
|
298
|
2624 {
|
|
2625 Lisp_Object val;
|
|
2626
|
40656
|
2627 CHECK_NUMBER_COERCE_MARKER (x);
|
|
2628 CHECK_NUMBER_COERCE_MARKER (y);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2629
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2630 if (XFASTINT (y) == 0)
|
71973
|
2631 xsignal0 (Qarith_error);
|
3338
|
2632
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2633 XSETINT (val, XINT (x) % XINT (y));
|
298
|
2634 return val;
|
|
2635 }
|
|
2636
|
5776
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2637 #ifndef HAVE_FMOD
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2638 double
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2639 fmod (f1, f2)
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2640 double f1, f2;
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2641 {
|
16945
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2642 double r = f1;
|
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2643
|
13296
|
2644 if (f2 < 0.0)
|
|
2645 f2 = -f2;
|
16945
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2646
|
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2647 /* 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
|
2648 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
|
2649 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
|
2650 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
|
2651 range promised by fmod. */
|
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2652 do
|
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2653 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
|
2654 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
|
2655
|
d6cd00b2e214
(isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2656 return r;
|
5776
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2657 }
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2658 #endif /* ! HAVE_FMOD */
|
6130ebde8d3b
(fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2659
|
4508
|
2660 DEFUN ("mod", Fmod, Smod, 2, 2, 0,
|
41153
|
2661 doc: /* Return X modulo Y.
|
40123
|
2662 The result falls between zero (inclusive) and Y (exclusive).
|
|
2663 Both X and Y must be numbers or markers. */)
|
|
2664 (x, y)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2665 register Lisp_Object x, y;
|
4508
|
2666 {
|
|
2667 Lisp_Object val;
|
11688
|
2668 EMACS_INT i1, i2;
|
4508
|
2669
|
40656
|
2670 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x);
|
|
2671 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2672
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2673 if (FLOATP (x) || FLOATP (y))
|
16787
|
2674 return fmod_float (x, y);
|
4508
|
2675
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2676 i1 = XINT (x);
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2677 i2 = XINT (y);
|
4508
|
2678
|
|
2679 if (i2 == 0)
|
71973
|
2680 xsignal0 (Qarith_error);
|
10605
|
2681
|
4508
|
2682 i1 %= i2;
|
|
2683
|
|
2684 /* If the "remainder" comes out with the wrong sign, fix it. */
|
11155
|
2685 if (i2 < 0 ? i1 > 0 : i1 < 0)
|
4508
|
2686 i1 += i2;
|
|
2687
|
9263
cda13734e32c
(make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2688 XSETINT (val, i1);
|
4508
|
2689 return val;
|
|
2690 }
|
|
2691
|
298
|
2692 DEFUN ("max", Fmax, Smax, 1, MANY, 0,
|
40123
|
2693 doc: /* Return largest of all the arguments (which must be numbers or markers).
|
40116
|
2694 The value is always a number; markers are converted to numbers.
|
40123
|
2695 usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
|
|
2696 (nargs, args)
|
298
|
2697 int nargs;
|
|
2698 Lisp_Object *args;
|
|
2699 {
|
|
2700 return arith_driver (Amax, nargs, args);
|
|
2701 }
|
|
2702
|
|
2703 DEFUN ("min", Fmin, Smin, 1, MANY, 0,
|
40123
|
2704 doc: /* Return smallest of all the arguments (which must be numbers or markers).
|
40116
|
2705 The value is always a number; markers are converted to numbers.
|
40123
|
2706 usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
|
|
2707 (nargs, args)
|
298
|
2708 int nargs;
|
|
2709 Lisp_Object *args;
|
|
2710 {
|
|
2711 return arith_driver (Amin, nargs, args);
|
|
2712 }
|
|
2713
|
|
2714 DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
|
40123
|
2715 doc: /* Return bitwise-and of all the arguments.
|
40116
|
2716 Arguments may be integers, or markers converted to integers.
|
40123
|
2717 usage: (logand &rest INTS-OR-MARKERS) */)
|
|
2718 (nargs, args)
|
298
|
2719 int nargs;
|
|
2720 Lisp_Object *args;
|
|
2721 {
|
|
2722 return arith_driver (Alogand, nargs, args);
|
|
2723 }
|
|
2724
|
|
2725 DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
|
40123
|
2726 doc: /* Return bitwise-or of all the arguments.
|
40116
|
2727 Arguments may be integers, or markers converted to integers.
|
40123
|
2728 usage: (logior &rest INTS-OR-MARKERS) */)
|
|
2729 (nargs, args)
|
298
|
2730 int nargs;
|
|
2731 Lisp_Object *args;
|
|
2732 {
|
|
2733 return arith_driver (Alogior, nargs, args);
|
|
2734 }
|
|
2735
|
|
2736 DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
|
40123
|
2737 doc: /* Return bitwise-exclusive-or of all the arguments.
|
40116
|
2738 Arguments may be integers, or markers converted to integers.
|
73925
|
2739 usage: (logxor &rest INTS-OR-MARKERS) */)
|
40123
|
2740 (nargs, args)
|
298
|
2741 int nargs;
|
|
2742 Lisp_Object *args;
|
|
2743 {
|
|
2744 return arith_driver (Alogxor, nargs, args);
|
|
2745 }
|
|
2746
|
|
2747 DEFUN ("ash", Fash, Sash, 2, 2, 0,
|
40123
|
2748 doc: /* Return VALUE with its bits shifted left by COUNT.
|
|
2749 If COUNT is negative, shifting is actually to the right.
|
|
2750 In this case, the sign bit is duplicated. */)
|
|
2751 (value, count)
|
11002
|
2752 register Lisp_Object value, count;
|
298
|
2753 {
|
|
2754 register Lisp_Object val;
|
|
2755
|
40656
|
2756 CHECK_NUMBER (value);
|
|
2757 CHECK_NUMBER (count);
|
298
|
2758
|
21819
|
2759 if (XINT (count) >= BITS_PER_EMACS_INT)
|
|
2760 XSETINT (val, 0);
|
|
2761 else if (XINT (count) > 0)
|
10951
|
2762 XSETINT (val, XINT (value) << XFASTINT (count));
|
21819
|
2763 else if (XINT (count) <= -BITS_PER_EMACS_INT)
|
|
2764 XSETINT (val, XINT (value) < 0 ? -1 : 0);
|
298
|
2765 else
|
10951
|
2766 XSETINT (val, XINT (value) >> -XINT (count));
|
298
|
2767 return val;
|
|
2768 }
|
|
2769
|
|
2770 DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
|
40123
|
2771 doc: /* Return VALUE with its bits shifted left by COUNT.
|
|
2772 If COUNT is negative, shifting is actually to the right.
|
47276
|
2773 In this case, zeros are shifted in on the left. */)
|
40123
|
2774 (value, count)
|
10951
|
2775 register Lisp_Object value, count;
|
298
|
2776 {
|
|
2777 register Lisp_Object val;
|
|
2778
|
40656
|
2779 CHECK_NUMBER (value);
|
|
2780 CHECK_NUMBER (count);
|
298
|
2781
|
21819
|
2782 if (XINT (count) >= BITS_PER_EMACS_INT)
|
|
2783 XSETINT (val, 0);
|
|
2784 else if (XINT (count) > 0)
|
10951
|
2785 XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
|
21819
|
2786 else if (XINT (count) <= -BITS_PER_EMACS_INT)
|
|
2787 XSETINT (val, 0);
|
298
|
2788 else
|
10951
|
2789 XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
|
298
|
2790 return val;
|
|
2791 }
|
|
2792
|
|
2793 DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
|
40123
|
2794 doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
|
|
2795 Markers are converted to integers. */)
|
|
2796 (number)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2797 register Lisp_Object number;
|
298
|
2798 {
|
40656
|
2799 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2800
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2801 if (FLOATP (number))
|
26164
|
2802 return (make_float (1.0 + XFLOAT_DATA (number)));
|
298
|
2803
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2804 XSETINT (number, XINT (number) + 1);
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2805 return number;
|
298
|
2806 }
|
|
2807
|
|
2808 DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
|
40123
|
2809 doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
|
|
2810 Markers are converted to integers. */)
|
|
2811 (number)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2812 register Lisp_Object number;
|
298
|
2813 {
|
40656
|
2814 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number);
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2815
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2816 if (FLOATP (number))
|
26164
|
2817 return (make_float (-1.0 + XFLOAT_DATA (number)));
|
298
|
2818
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2819 XSETINT (number, XINT (number) - 1);
|
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2820 return number;
|
298
|
2821 }
|
|
2822
|
|
2823 DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
|
40123
|
2824 doc: /* Return the bitwise complement of NUMBER. NUMBER must be an integer. */)
|
|
2825 (number)
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2826 register Lisp_Object number;
|
298
|
2827 {
|
40656
|
2828 CHECK_NUMBER (number);
|
14096
|
2829 XSETINT (number, ~XINT (number));
|
14066
2c6db67067ac
(Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2830 return number;
|
298
|
2831 }
|
53910
|
2832
|
|
2833 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
|
|
2834 doc: /* Return the byteorder for the machine.
|
|
2835 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
|
|
2836 lowercase l) for small endian machines. */)
|
|
2837 ()
|
|
2838 {
|
|
2839 unsigned i = 0x04030201;
|
54660
122a60d4f165
data.c (Fbyteorder): Make test work even if unsigned is not 4 bytes.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2840 int order = *(char *)&i == 1 ? 108 : 66;
|
53910
|
2841
|
53966
|
2842 return make_number (order);
|
53910
|
2843 }
|
|
2844
|
|
2845
|
298
|
2846
|
|
2847 void
|
|
2848 syms_of_data ()
|
|
2849 {
|
2092
|
2850 Lisp_Object error_tail, arith_tail;
|
|
2851
|
298
|
2852 Qquote = intern ("quote");
|
|
2853 Qlambda = intern ("lambda");
|
|
2854 Qsubr = intern ("subr");
|
|
2855 Qerror_conditions = intern ("error-conditions");
|
|
2856 Qerror_message = intern ("error-message");
|
|
2857 Qtop_level = intern ("top-level");
|
|
2858
|
|
2859 Qerror = intern ("error");
|
|
2860 Qquit = intern ("quit");
|
|
2861 Qwrong_type_argument = intern ("wrong-type-argument");
|
|
2862 Qargs_out_of_range = intern ("args-out-of-range");
|
|
2863 Qvoid_function = intern ("void-function");
|
648
|
2864 Qcyclic_function_indirection = intern ("cyclic-function-indirection");
|
39575
|
2865 Qcyclic_variable_indirection = intern ("cyclic-variable-indirection");
|
298
|
2866 Qvoid_variable = intern ("void-variable");
|
|
2867 Qsetting_constant = intern ("setting-constant");
|
|
2868 Qinvalid_read_syntax = intern ("invalid-read-syntax");
|
|
2869
|
|
2870 Qinvalid_function = intern ("invalid-function");
|
|
2871 Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
|
|
2872 Qno_catch = intern ("no-catch");
|
|
2873 Qend_of_file = intern ("end-of-file");
|
|
2874 Qarith_error = intern ("arith-error");
|
|
2875 Qbeginning_of_buffer = intern ("beginning-of-buffer");
|
|
2876 Qend_of_buffer = intern ("end-of-buffer");
|
|
2877 Qbuffer_read_only = intern ("buffer-read-only");
|
26274
|
2878 Qtext_read_only = intern ("text-read-only");
|
4036
|
2879 Qmark_inactive = intern ("mark-inactive");
|
298
|
2880
|
|
2881 Qlistp = intern ("listp");
|
|
2882 Qconsp = intern ("consp");
|
|
2883 Qsymbolp = intern ("symbolp");
|
26931
|
2884 Qkeywordp = intern ("keywordp");
|
298
|
2885 Qintegerp = intern ("integerp");
|
|
2886 Qnatnump = intern ("natnump");
|
6459
|
2887 Qwholenump = intern ("wholenump");
|
298
|
2888 Qstringp = intern ("stringp");
|
|
2889 Qarrayp = intern ("arrayp");
|
|
2890 Qsequencep = intern ("sequencep");
|
|
2891 Qbufferp = intern ("bufferp");
|
|
2892 Qvectorp = intern ("vectorp");
|
|
2893 Qchar_or_string_p = intern ("char-or-string-p");
|
|
2894 Qmarkerp = intern ("markerp");
|
1293
|
2895 Qbuffer_or_string_p = intern ("buffer-or-string-p");
|
298
|
2896 Qinteger_or_marker_p = intern ("integer-or-marker-p");
|
|
2897 Qboundp = intern ("boundp");
|
|
2898 Qfboundp = intern ("fboundp");
|
|
2899
|
|
2900 Qfloatp = intern ("floatp");
|
|
2901 Qnumberp = intern ("numberp");
|
|
2902 Qnumber_or_marker_p = intern ("number-or-marker-p");
|
|
2903
|
13148
|
2904 Qchar_table_p = intern ("char-table-p");
|
13200
|
2905 Qvector_or_char_table_p = intern ("vector-or-char-table-p");
|
13148
|
2906
|
29237
|
2907 Qsubrp = intern ("subrp");
|
|
2908 Qunevalled = intern ("unevalled");
|
|
2909 Qmany = intern ("many");
|
|
2910
|
298
|
2911 Qcdr = intern ("cdr");
|
|
2912
|
8401
|
2913 /* Handle automatic advice activation */
|
8448
|
2914 Qad_advice_info = intern ("ad-advice-info");
|
26205
|
2915 Qad_activate_internal = intern ("ad-activate-internal");
|
8401
|
2916
|
2092
|
2917 error_tail = Fcons (Qerror, Qnil);
|
|
2918
|
298
|
2919 /* ERROR is used as a signaler for random errors for which nothing else is right */
|
|
2920
|
|
2921 Fput (Qerror, Qerror_conditions,
|
2092
|
2922 error_tail);
|
298
|
2923 Fput (Qerror, Qerror_message,
|
|
2924 build_string ("error"));
|
|
2925
|
|
2926 Fput (Qquit, Qerror_conditions,
|
|
2927 Fcons (Qquit, Qnil));
|
|
2928 Fput (Qquit, Qerror_message,
|
|
2929 build_string ("Quit"));
|
|
2930
|
|
2931 Fput (Qwrong_type_argument, Qerror_conditions,
|
2092
|
2932 Fcons (Qwrong_type_argument, error_tail));
|
298
|
2933 Fput (Qwrong_type_argument, Qerror_message,
|
|
2934 build_string ("Wrong type argument"));
|
|
2935
|
|
2936 Fput (Qargs_out_of_range, Qerror_conditions,
|
2092
|
2937 Fcons (Qargs_out_of_range, error_tail));
|
298
|
2938 Fput (Qargs_out_of_range, Qerror_message,
|
|
2939 build_string ("Args out of range"));
|
|
2940
|
|
2941 Fput (Qvoid_function, Qerror_conditions,
|
2092
|
2942 Fcons (Qvoid_function, error_tail));
|
298
|
2943 Fput (Qvoid_function, Qerror_message,
|
|
2944 build_string ("Symbol's function definition is void"));
|
|
2945
|
648
|
2946 Fput (Qcyclic_function_indirection, Qerror_conditions,
|
2092
|
2947 Fcons (Qcyclic_function_indirection, error_tail));
|
648
|
2948 Fput (Qcyclic_function_indirection, Qerror_message,
|
|
2949 build_string ("Symbol's chain of function indirections contains a loop"));
|
|
2950
|
39575
|
2951 Fput (Qcyclic_variable_indirection, Qerror_conditions,
|
|
2952 Fcons (Qcyclic_variable_indirection, error_tail));
|
|
2953 Fput (Qcyclic_variable_indirection, Qerror_message,
|
|
2954 build_string ("Symbol's chain of variable indirections contains a loop"));
|
|
2955
|
39767
|
2956 Qcircular_list = intern ("circular-list");
|
|
2957 staticpro (&Qcircular_list);
|
|
2958 Fput (Qcircular_list, Qerror_conditions,
|
|
2959 Fcons (Qcircular_list, error_tail));
|
|
2960 Fput (Qcircular_list, Qerror_message,
|
|
2961 build_string ("List contains a loop"));
|
|
2962
|
298
|
2963 Fput (Qvoid_variable, Qerror_conditions,
|
2092
|
2964 Fcons (Qvoid_variable, error_tail));
|
298
|
2965 Fput (Qvoid_variable, Qerror_message,
|
|
2966 build_string ("Symbol's value as variable is void"));
|
|
2967
|
|
2968 Fput (Qsetting_constant, Qerror_conditions,
|
2092
|
2969 Fcons (Qsetting_constant, error_tail));
|
298
|
2970 Fput (Qsetting_constant, Qerror_message,
|
|
2971 build_string ("Attempt to set a constant symbol"));
|
|
2972
|
|
2973 Fput (Qinvalid_read_syntax, Qerror_conditions,
|
2092
|
2974 Fcons (Qinvalid_read_syntax, error_tail));
|
298
|
2975 Fput (Qinvalid_read_syntax, Qerror_message,
|
|
2976 build_string ("Invalid read syntax"));
|
|
2977
|
|
2978 Fput (Qinvalid_function, Qerror_conditions,
|
2092
|
2979 Fcons (Qinvalid_function, error_tail));
|
298
|
2980 Fput (Qinvalid_function, Qerror_message,
|
|
2981 build_string ("Invalid function"));
|
|
2982
|
|
2983 Fput (Qwrong_number_of_arguments, Qerror_conditions,
|
2092
|
2984 Fcons (Qwrong_number_of_arguments, error_tail));
|
298
|
2985 Fput (Qwrong_number_of_arguments, Qerror_message,
|
|
2986 build_string ("Wrong number of arguments"));
|
|
2987
|
|
2988 Fput (Qno_catch, Qerror_conditions,
|
2092
|
2989 Fcons (Qno_catch, error_tail));
|
298
|
2990 Fput (Qno_catch, Qerror_message,
|
|
2991 build_string ("No catch for tag"));
|
|
2992
|
|
2993 Fput (Qend_of_file, Qerror_conditions,
|
2092
|
2994 Fcons (Qend_of_file, error_tail));
|
298
|
2995 Fput (Qend_of_file, Qerror_message,
|
|
2996 build_string ("End of file during parsing"));
|
|
2997
|
2092
|
2998 arith_tail = Fcons (Qarith_error, error_tail);
|
298
|
2999 Fput (Qarith_error, Qerror_conditions,
|
2092
|
3000 arith_tail);
|
298
|
3001 Fput (Qarith_error, Qerror_message,
|
|
3002 build_string ("Arithmetic error"));
|
|
3003
|
|
3004 Fput (Qbeginning_of_buffer, Qerror_conditions,
|
2092
|
3005 Fcons (Qbeginning_of_buffer, error_tail));
|
298
|
3006 Fput (Qbeginning_of_buffer, Qerror_message,
|
|
3007 build_string ("Beginning of buffer"));
|
|
3008
|
|
3009 Fput (Qend_of_buffer, Qerror_conditions,
|
2092
|
3010 Fcons (Qend_of_buffer, error_tail));
|
298
|
3011 Fput (Qend_of_buffer, Qerror_message,
|
|
3012 build_string ("End of buffer"));
|
|
3013
|
|
3014 Fput (Qbuffer_read_only, Qerror_conditions,
|
2092
|
3015 Fcons (Qbuffer_read_only, error_tail));
|
298
|
3016 Fput (Qbuffer_read_only, Qerror_message,
|
|
3017 build_string ("Buffer is read-only"));
|
|
3018
|
26274
|
3019 Fput (Qtext_read_only, Qerror_conditions,
|
|
3020 Fcons (Qtext_read_only, error_tail));
|
|
3021 Fput (Qtext_read_only, Qerror_message,
|
|
3022 build_string ("Text is read-only"));
|
|
3023
|
2092
|
3024 Qrange_error = intern ("range-error");
|
|
3025 Qdomain_error = intern ("domain-error");
|
|
3026 Qsingularity_error = intern ("singularity-error");
|
|
3027 Qoverflow_error = intern ("overflow-error");
|
|
3028 Qunderflow_error = intern ("underflow-error");
|
|
3029
|
|
3030 Fput (Qdomain_error, Qerror_conditions,
|
|
3031 Fcons (Qdomain_error, arith_tail));
|
|
3032 Fput (Qdomain_error, Qerror_message,
|
|
3033 build_string ("Arithmetic domain error"));
|
|
3034
|
|
3035 Fput (Qrange_error, Qerror_conditions,
|
|
3036 Fcons (Qrange_error, arith_tail));
|
|
3037 Fput (Qrange_error, Qerror_message,
|
|
3038 build_string ("Arithmetic range error"));
|
|
3039
|
|
3040 Fput (Qsingularity_error, Qerror_conditions,
|
|
3041 Fcons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
|
|
3042 Fput (Qsingularity_error, Qerror_message,
|
|
3043 build_string ("Arithmetic singularity error"));
|
|
3044
|
|
3045 Fput (Qoverflow_error, Qerror_conditions,
|
|
3046 Fcons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
|
|
3047 Fput (Qoverflow_error, Qerror_message,
|
|
3048 build_string ("Arithmetic overflow error"));
|
|
3049
|
|
3050 Fput (Qunderflow_error, Qerror_conditions,
|
|
3051 Fcons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
|
|
3052 Fput (Qunderflow_error, Qerror_message,
|
|
3053 build_string ("Arithmetic underflow error"));
|
|
3054
|
|
3055 staticpro (&Qrange_error);
|
|
3056 staticpro (&Qdomain_error);
|
|
3057 staticpro (&Qsingularity_error);
|
|
3058 staticpro (&Qoverflow_error);
|
|
3059 staticpro (&Qunderflow_error);
|
|
3060
|
298
|
3061 staticpro (&Qnil);
|
|
3062 staticpro (&Qt);
|
|
3063 staticpro (&Qquote);
|
|
3064 staticpro (&Qlambda);
|
|
3065 staticpro (&Qsubr);
|
|
3066 staticpro (&Qunbound);
|
|
3067 staticpro (&Qerror_conditions);
|
|
3068 staticpro (&Qerror_message);
|
|
3069 staticpro (&Qtop_level);
|
|
3070
|
|
3071 staticpro (&Qerror);
|
|
3072 staticpro (&Qquit);
|
|
3073 staticpro (&Qwrong_type_argument);
|
|
3074 staticpro (&Qargs_out_of_range);
|
|
3075 staticpro (&Qvoid_function);
|
648
|
3076 staticpro (&Qcyclic_function_indirection);
|
61888
|
3077 staticpro (&Qcyclic_variable_indirection);
|
298
|
3078 staticpro (&Qvoid_variable);
|
|
3079 staticpro (&Qsetting_constant);
|
|
3080 staticpro (&Qinvalid_read_syntax);
|
|
3081 staticpro (&Qwrong_number_of_arguments);
|
|
3082 staticpro (&Qinvalid_function);
|
|
3083 staticpro (&Qno_catch);
|
|
3084 staticpro (&Qend_of_file);
|
|
3085 staticpro (&Qarith_error);
|
|
3086 staticpro (&Qbeginning_of_buffer);
|
|
3087 staticpro (&Qend_of_buffer);
|
|
3088 staticpro (&Qbuffer_read_only);
|
26274
|
3089 staticpro (&Qtext_read_only);
|
4037
|
3090 staticpro (&Qmark_inactive);
|
298
|
3091
|
|
3092 staticpro (&Qlistp);
|
|
3093 staticpro (&Qconsp);
|
|
3094 staticpro (&Qsymbolp);
|
26931
|
3095 staticpro (&Qkeywordp);
|
298
|
3096 staticpro (&Qintegerp);
|
|
3097 staticpro (&Qnatnump);
|
6459
|
3098 staticpro (&Qwholenump);
|
298
|
3099 staticpro (&Qstringp);
|
|
3100 staticpro (&Qarrayp);
|
|
3101 staticpro (&Qsequencep);
|
|
3102 staticpro (&Qbufferp);
|
|
3103 staticpro (&Qvectorp);
|
|
3104 staticpro (&Qchar_or_string_p);
|
|
3105 staticpro (&Qmarkerp);
|
1293
|
3106 staticpro (&Qbuffer_or_string_p);
|
298
|
3107 staticpro (&Qinteger_or_marker_p);
|
|
3108 staticpro (&Qfloatp);
|
695
|
3109 staticpro (&Qnumberp);
|
|
3110 staticpro (&Qnumber_or_marker_p);
|
13148
|
3111 staticpro (&Qchar_table_p);
|
13200
|
3112 staticpro (&Qvector_or_char_table_p);
|
29237
|
3113 staticpro (&Qsubrp);
|
|
3114 staticpro (&Qmany);
|
|
3115 staticpro (&Qunevalled);
|
298
|
3116
|
|
3117 staticpro (&Qboundp);
|
|
3118 staticpro (&Qfboundp);
|
|
3119 staticpro (&Qcdr);
|
8448
|
3120 staticpro (&Qad_advice_info);
|
26205
|
3121 staticpro (&Qad_activate_internal);
|
298
|
3122
|
10725
|
3123 /* Types that type-of returns. */
|
|
3124 Qinteger = intern ("integer");
|
|
3125 Qsymbol = intern ("symbol");
|
|
3126 Qstring = intern ("string");
|
|
3127 Qcons = intern ("cons");
|
|
3128 Qmarker = intern ("marker");
|
|
3129 Qoverlay = intern ("overlay");
|
|
3130 Qfloat = intern ("float");
|
|
3131 Qwindow_configuration = intern ("window-configuration");
|
|
3132 Qprocess = intern ("process");
|
|
3133 Qwindow = intern ("window");
|
|
3134 /* Qsubr = intern ("subr"); */
|
|
3135 Qcompiled_function = intern ("compiled-function");
|
|
3136 Qbuffer = intern ("buffer");
|
|
3137 Qframe = intern ("frame");
|
|
3138 Qvector = intern ("vector");
|
13715
|
3139 Qchar_table = intern ("char-table");
|
|
3140 Qbool_vector = intern ("bool-vector");
|
26185
|
3141 Qhash_table = intern ("hash-table");
|
10725
|
3142
|
|
3143 staticpro (&Qinteger);
|
|
3144 staticpro (&Qsymbol);
|
|
3145 staticpro (&Qstring);
|
|
3146 staticpro (&Qcons);
|
|
3147 staticpro (&Qmarker);
|
|
3148 staticpro (&Qoverlay);
|
|
3149 staticpro (&Qfloat);
|
|
3150 staticpro (&Qwindow_configuration);
|
|
3151 staticpro (&Qprocess);
|
|
3152 staticpro (&Qwindow);
|
|
3153 /* staticpro (&Qsubr); */
|
|
3154 staticpro (&Qcompiled_function);
|
|
3155 staticpro (&Qbuffer);
|
|
3156 staticpro (&Qframe);
|
|
3157 staticpro (&Qvector);
|
13715
|
3158 staticpro (&Qchar_table);
|
|
3159 staticpro (&Qbool_vector);
|
26185
|
3160 staticpro (&Qhash_table);
|
10725
|
3161
|
39575
|
3162 defsubr (&Sindirect_variable);
|
54627
532e0d3d8fc1
(Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3163 defsubr (&Sinteractive_form);
|
298
|
3164 defsubr (&Seq);
|
|
3165 defsubr (&Snull);
|
10725
|
3166 defsubr (&Stype_of);
|
298
|
3167 defsubr (&Slistp);
|
|
3168 defsubr (&Snlistp);
|
|
3169 defsubr (&Sconsp);
|
|
3170 defsubr (&Satom);
|
|
3171 defsubr (&Sintegerp);
|
695
|
3172 defsubr (&Sinteger_or_marker_p);
|
|
3173 defsubr (&Snumberp);
|
|
3174 defsubr (&Snumber_or_marker_p);
|
298
|
3175 defsubr (&Sfloatp);
|
|
3176 defsubr (&Snatnump);
|
|
3177 defsubr (&Ssymbolp);
|
26931
|
3178 defsubr (&Skeywordp);
|
298
|
3179 defsubr (&Sstringp);
|
20793
|
3180 defsubr (&Smultibyte_string_p);
|
298
|
3181 defsubr (&Svectorp);
|
13148
|
3182 defsubr (&Schar_table_p);
|
13200
|
3183 defsubr (&Svector_or_char_table_p);
|
13148
|
3184 defsubr (&Sbool_vector_p);
|
298
|
3185 defsubr (&Sarrayp);
|
|
3186 defsubr (&Ssequencep);
|
|
3187 defsubr (&Sbufferp);
|
|
3188 defsubr (&Smarkerp);
|
|
3189 defsubr (&Ssubrp);
|
1821
|
3190 defsubr (&Sbyte_code_function_p);
|
298
|
3191 defsubr (&Schar_or_string_p);
|
|
3192 defsubr (&Scar);
|
|
3193 defsubr (&Scdr);
|
|
3194 defsubr (&Scar_safe);
|
|
3195 defsubr (&Scdr_safe);
|
|
3196 defsubr (&Ssetcar);
|
|
3197 defsubr (&Ssetcdr);
|
|
3198 defsubr (&Ssymbol_function);
|
648
|
3199 defsubr (&Sindirect_function);
|
298
|
3200 defsubr (&Ssymbol_plist);
|
|
3201 defsubr (&Ssymbol_name);
|
|
3202 defsubr (&Smakunbound);
|
|
3203 defsubr (&Sfmakunbound);
|
|
3204 defsubr (&Sboundp);
|
|
3205 defsubr (&Sfboundp);
|
|
3206 defsubr (&Sfset);
|
2565
c1a1557bffde
(Fdefine_function): Changed name back to Fdefalias, so we get things
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
3207 defsubr (&Sdefalias);
|
298
|
3208 defsubr (&Ssetplist);
|
|
3209 defsubr (&Ssymbol_value);
|
|
3210 defsubr (&Sset);
|
|
3211 defsubr (&Sdefault_boundp);
|
|
3212 defsubr (&Sdefault_value);
|
|
3213 defsubr (&Sset_default);
|
|
3214 defsubr (&Ssetq_default);
|
|
3215 defsubr (&Smake_variable_buffer_local);
|
|
3216 defsubr (&Smake_local_variable);
|
|
3217 defsubr (&Skill_local_variable);
|
21144
|
3218 defsubr (&Smake_variable_frame_local);
|
9194
|
3219 defsubr (&Slocal_variable_p);
|
12295
|
3220 defsubr (&Slocal_variable_if_set_p);
|
52537
|
3221 defsubr (&Svariable_binding_locus);
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
3222 #if 0 /* XXX Remove this. --lorentey */
|
83325
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
3223 defsubr (&Sterminal_local_value);
|
9e41c80c6389
Work around nondeterministic binding of terminal-local variables. (Fixes national character input on ttys.)
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
3224 defsubr (&Sset_terminal_local_value);
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
3225 #endif
|
298
|
3226 defsubr (&Saref);
|
|
3227 defsubr (&Saset);
|
2429
|
3228 defsubr (&Snumber_to_string);
|
1914
|
3229 defsubr (&Sstring_to_number);
|
298
|
3230 defsubr (&Seqlsign);
|
|
3231 defsubr (&Slss);
|
|
3232 defsubr (&Sgtr);
|
|
3233 defsubr (&Sleq);
|
|
3234 defsubr (&Sgeq);
|
|
3235 defsubr (&Sneq);
|
|
3236 defsubr (&Szerop);
|
|
3237 defsubr (&Splus);
|
|
3238 defsubr (&Sminus);
|
|
3239 defsubr (&Stimes);
|
|
3240 defsubr (&Squo);
|
|
3241 defsubr (&Srem);
|
4508
|
3242 defsubr (&Smod);
|
298
|
3243 defsubr (&Smax);
|
|
3244 defsubr (&Smin);
|
|
3245 defsubr (&Slogand);
|
|
3246 defsubr (&Slogior);
|
|
3247 defsubr (&Slogxor);
|
|
3248 defsubr (&Slsh);
|
|
3249 defsubr (&Sash);
|
|
3250 defsubr (&Sadd1);
|
|
3251 defsubr (&Ssub1);
|
|
3252 defsubr (&Slognot);
|
53910
|
3253 defsubr (&Sbyteorder);
|
29237
|
3254 defsubr (&Ssubr_arity);
|
55230
|
3255 defsubr (&Ssubr_name);
|
6459
|
3256
|
9954
|
3257 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
|
39632
|
3258
|
41865
|
3259 DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
|
|
3260 doc: /* The largest value that is representable in a Lisp integer. */);
|
|
3261 Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
|
93259
|
3262 XSYMBOL (intern ("most-positive-fixnum"))->constant = 1;
|
48961
|
3263
|
41865
|
3264 DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,
|
|
3265 doc: /* The smallest value that is representable in a Lisp integer. */);
|
|
3266 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
|
93259
|
3267 XSYMBOL (intern ("most-negative-fixnum"))->constant = 1;
|
298
|
3268 }
|
|
3269
|
490
|
3270 SIGTYPE
|
298
|
3271 arith_error (signo)
|
|
3272 int signo;
|
|
3273 {
|
16150
|
3274 #if defined(USG) && !defined(POSIX_SIGNALS)
|
298
|
3275 /* USG systems forget handlers when they are used;
|
|
3276 must reestablish each time */
|
|
3277 signal (signo, arith_error);
|
|
3278 #endif /* USG */
|
638
|
3279 sigsetmask (SIGEMPTYMASK);
|
298
|
3280
|
58986
|
3281 SIGNAL_THREAD_CHECK (signo);
|
71973
|
3282 xsignal0 (Qarith_error);
|
298
|
3283 }
|
|
3284
|
21514
|
3285 void
|
298
|
3286 init_data ()
|
|
3287 {
|
|
3288 /* Don't do this if just dumping out.
|
|
3289 We don't want to call `signal' in this case
|
|
3290 so that we don't have trouble with dumping
|
|
3291 signal-delivering routines in an inconsistent state. */
|
|
3292 #ifndef CANNOT_DUMP
|
|
3293 if (!initialized)
|
|
3294 return;
|
|
3295 #endif /* CANNOT_DUMP */
|
|
3296 signal (SIGFPE, arith_error);
|
10605
|
3297
|
298
|
3298 #ifdef uts
|
|
3299 signal (SIGEMT, arith_error);
|
|
3300 #endif /* uts */
|
|
3301 }
|
52401
|
3302
|
|
3303 /* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7
|
|
3304 (do not change this comment) */
|