annotate src/data.c @ 18156:f7296dc03177

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