annotate src/data.c @ 11501:a56d6a86fa85

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