annotate src/data.c @ 14814:3793008500cd

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