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