annotate src/data.c @ 27188:8cd1df305566

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